戻る  □一般操作のサロン  □ 使用方法  □ 新着記事  □ 新規に質問する!  □ トピック一覧  □ 検索  □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
このトピック参照回数 :
一組のデータ(複数行複数列)を横一覧のデータにするには

    [189523] 一組のデータ(複数行複数列)を横一覧のデータにするには-

    ■親トピック/記事引用/メール受信=OFF■

    □投稿者/ VBA初心者 -(2019/06/12(21:00))
    □U R L/
      下記の左データを右列一覧に変更する場合です。
      
          A    B     C   D     E      F    G     H    I      J
      1  名前  種類イ       種類ロ          名前   果物    肉   野菜   菓子
      2 山田  果物   1  肉      3   山田  1   2   3   4
      3     野菜    2  菓子    4   吉永  5      6      7      8
      4 吉永  果物   5  肉      7   小川  11  12   13   14
      5     野菜    6  菓子    8   清水  15    16     17     18
      6  小川  果物  11  肉     13   
      7     野菜   12  菓子   14
      8 清水  果物  15  肉     17    
      9     野菜   16  菓子   18
      10
      11
      
      一組のデータが縦横2行2列となっていて これを
      右の列に1行に4つの列に置き換えたいのです。
      (実際にはデータはもっと多いです。(わかりやすい数字にしています))
      
      自分なりに下記にコードを作成してみました。
      
      Private Sub CommandButton1_Click()
      Dim n1 As Long
      Dim n2 As Long
      Dim n3 As Long
      Dim n4 As Long
      Dim nr1 As Long
      Dim nr2 As Long
      Dim retu As Long
      Dim nr As Long
      Dim n As Long
      
      nr = Cells(Rows.Count, 1).End(xlUp).Row
      For n1 = 2 To nr Step 2
          Cells(n1 + 1, 8) = Cells(n1, 1)
      Next
      
      'Range("").Offset(1, 0).Select
      
      nr2 = Cells(Rows.Count, 3).End(xlUp).Row
      
      For n2 = 2 To nr2 Step 2
          For retu = 1 To 4 Step 2
              For n3 = 2 To 3
                  Cells(n2, retu + 8) = Cells(n2, retu + 2)
             Next
          Next
      Next
      
      For n2 = 2 To nr2 Step 2
          For retu = 1 To 4 Step 2
              For n3 = 3 To 3
                  Cells(n2, retu + 9) = Cells(n2 + 1, retu + 2)
             Next
          Next
      Next
      End Sub
      
      Private Sub CommandButton2_Click()
      
      Dim n1 As Long
      Dim n2 As Long
      Dim n3 As Long
      Dim n4 As Long
      Dim nr1 As Long
      Dim nr2 As Long
      Dim retu As Long
      Dim retu1 As Long
      Dim retu2 As Long
      Dim nr As Long
      Dim n As Long
      
      nr = Cells(Rows.Count, 1).End(xlUp).Row
      For n1 = 2 To nr Step 2
          Cells(n1 + 1, 8) = Cells(n1, 1)
      Next
      
      'Range("").Offset(1, 0).Select
      
      nr2 = Cells(Rows.Count, 3).End(xlUp).Row
      
      For n2 = 2 To nr2 Step 2
          For retu = 1 To 4 Step 2
              For n3 = 2 To 3
                  Cells(n2, retu + 8) = Cells(n2, retu + 2)
             Next
          Next
      Next
      
      For n2 = 2 To nr2 Step 2
          For retu = 1 To 4 Step 2
              For n3 = 3 To 3
                  Cells(n2, retu + 9) = Cells(n2 + 1, retu + 2)
             Next
          Next
      Next
      End Sub
      
      しかし、私のコードでは
      1行おきのデータになってしましました。
      コード自体もあまり良くないと思っています。
      どなたか、きちんとしてコードに改良のほど
      ご教示いただけますと幸いです。
      
      
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189524] Re[1]: 一組のデータ(複数行複数列)を横一覧のデータにするには-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2019/06/12(22:44))
    □U R L/
      参考に
      Private Sub CommandButton1_Click()
          Dim LastRow As Long, i As Long, j As Long, k As Long
          Dim c As Range
          
          LastRow = Cells(Rows.Count, "A").End(xlUp).Row
          Range("F1").Resize(, 5).Value = Array("名前", "果物", "肉", "野菜", "菓子")
          j = 2
          For i = 2 To LastRow Step 2
              k = 7
              Cells(j, "F").Value = Cells(i, "A").Value
              For Each c In Union(Cells(i, "C"), Cells(i, "E"), Cells(i + 1, "C"), Cells(i + 1, "E"))
                  Cells(j, k).Value = c.Value
                  k = k + 1
              Next
              j = j + 1
          Next
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189527] Re[2]: 一組のデータ(複数行複数列)を横一覧のデータにするには-

    記事引用/メール受信=OFF■

    □投稿者/ apple -(2019/06/13(00:02))
    □U R L/
      「果物、肉、野菜、菓子」の順序でデータを取り出すなら数値の並びは「1、3、2、4」にならないといけないのでは?
      
      Sub Sample()
          Dim i As Long
          Dim c As Range
          Dim r As Range
          Dim s As String
          Dim gyou As Long, retu As Long
          
          gyou = 1 '書き出し行位置の初期値
          retu = 8 '書き出し列位置の初期値
          For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 2
              Set r = Cells(i, 1).Offset(, 1).Resize(2, 2 * 2) ' 各名前に対応する実データ範囲 2 行 4 列
              For Each c In r.Rows ' 行方向を優先したセルアドレスを取得
                  ' 数値データのセルアドレスを取得
                  s = s & "," & c.SpecialCells(xlCellTypeConstants, xlNumbers).Address
              Next
              If i = 2 Then ' 見出しの作成
                  Cells(gyou, retu).Value = "名前"
                  For Each c In Range(Mid(s, 2)) ' 数値データ範囲をループ
                      retu = retu + 1 ' 列位置の更新
                      Cells(gyou, retu).Value = c.Offset(, -1).Value ' 数値データの左隣の種類名を
                  Next
              End If
              gyou = gyou + 1 ' 行位置の更新
              retu = 8        ' 列位置を初期値に戻す
              Cells(gyou, retu).Value = Cells(i, 1).Value
              For Each c In Range(Mid(s, 2)) ' 数値データの書き出し
                  retu = retu + 1 ' 列位置の更新
                  Cells(gyou, retu).Value = c.Value
              Next
              s = ""
          Next
      End Sub


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189528] Re[3]: 一組のデータ(複数行複数列)を横一覧のデータにするには-

    記事引用/メール受信=OFF■

    □投稿者/ ぴんく -(2019/06/13(07:58))
    □U R L/
      >数値の並びは「1、3、2、4」にならないといけないのでは?
      Private Sub CommandButton1_Click()
          Dim LastRow As Long, i As Long, j As Long, k As Long
          Dim c As Range
          
          LastRow = Cells(Rows.Count, "A").End(xlUp).Row
          Range("F1").Resize(, 5).Value = Array("名前", "果物", "肉", "野菜", "菓子")
          j = 2
          For i = 2 To LastRow Step 2
              k = 7
              Cells(j, "F").Value = Cells(i, "A").Value
              For Each c In Cells(i, "C").Resize(2, 3)
                  If c.Column <> 4 Then
                      Cells(j, k).Value = c.Value
                      k = k + 1
                  End If
              Next
              j = j + 1
          Next
      End Sub
      


      この記事にはVBAのコードが含まれています。

      緑の太文字→注釈
      茶色の太文字→条件分岐
      赤の太文字→ループ
      青の太文字→その他




    [189539] Re[4]: 一組のデータ(複数行複数列)を横一覧のデータにするには-

    解決!!ありがとうございました! / 記事引用/メール受信=OFF■

    □投稿者/ VBA初心者 -(2019/06/13(19:56))
    □U R L/

      ぴんくさん、
      apple さん、
      早速にご回答ありがとうございます。
      わたしのデータ例が誤っておりました。
      このようなコードは、全く思いつきません。
      大変、参考になります。
      お世話になりました。
      また、よろしくお願いいたします。



このトピック内容の全ページ数 / [0]

このトピックに書きこむ
Name/
E-Mail/

└>このツリーのレス記事をメールで受信しますか? YES/ NO/
Title/
URL/
Comment/ 通常モード->  図表モード-> (←の場合適当に改行を入れて下さい)
タグが使用できます。例 ⇒ <font color="blue">文字</font>
解決!!ありがとうございました! 解決       保留中です・・・ 保留        迷宮入りorほかあたって見ます・・ 迷宮入       すいませ〜ん。誰か〜! Help! ←※回答者専用
解決したらチェック       保留(コードテスト中など・・)         解決不可orレスが全く付かなくてほかのサイトに行くときなど・・
削除キー/
(半角8文字以内) 


- Child Forum -
Edit:ゆう-G