EXCELの表の展開の仕方を教えてください（VBAを利用？）

Question

1ユーザ1行で200行以上の表があります。
（ユーザ毎に）A列、B列は固定でC列以降に複数の商品（数は20以下の任意数）が
登録されているのですが、これを1行1商品に展開（分解）したいと思っています。
（添付のイメージです）

元の表はそのまま残し、別のシートに展開した結果を表示させるのが希望です。

毎月の作業のためマクロを利用したいと考えていますが可能でしょうか？

※）ちなみにこのような表の展開？を表す言葉や用語はありますでしょうか？
　　検索してもうまく見つけることができず、こちらで質問させていただくことにしました。

よろしくお願いします。

tom04 · Accepted Answer

こんにちは！
一例です。
Sheet1のデータは2行目からあり、Sheet2の2行目以降に表示されるとします。

ちょっと強引な方法ですが、Sheet1のSheet見出し上で右クリック　→　コードの表示　を選択し、
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test()
    Dim i, j, k As Long
    Dim ws1, ws2 As Worksheet
    Set ws1 = Worksheets("sheet1")
    Set ws2 = Worksheets("sheet2")
    i = 2
    j = 2
    k = ws1.UsedRange.Columns.Count
    Do While i <= j
        Do While j <= WorksheetFunction.CountA(ws1.Range(Cells(2, 3), Cells(i, k))) + 1
                With ws2.Cells(j, 1)
                .Value = ws1.Cells(i, 1)
                .Offset(, 1) = ws1.Cells(i, 2)
            End With
            j = j + 1
            Loop
        i = i + 1
        Loop
    Dim L, M, N As Long
    L = 2
    For M = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
    For N = 3 To ws1.Cells(M, Columns.Count).End(xlToLeft).Column
    ws2.Cells(L, 3) = ws1.Cells(M, N)
    L = L + 1
    Next N
    Next M
End Sub

以上、参考になればよいのですが・・・m(__)m

mike_g · Answer

Sheet2!A2: =OFFSET(Sheet1!$A$2,(ROW(A1)-1)/4,COLUMN(A1)-1)
Sheet2!B2: 上式をドラッグ＆ペースト
Sheet2!C2: =OFFSET(Sheet1!$C$2,(ROW(A1)-1)/4,MOD(ROW(A1)-1,4))

範囲A2:C2 を下方にズズーッとドラッグ＆ペースト（Fig2）
シート全体（あるいはシート内の全データ範囲）を選択して[コピー]→[値の貼り付け]を実行

Ｃ列が 0 のレコードを[オートフィルタ]で抽出（Fig3）

抽出された全行を削除して[オートフィルタ]を解除（Fig4）

xls88 · Answer

VBAの例です。
Sheet1からSheet2に書き出します。

Dim rng As Range
    Dim myval As Variant
    Dim n As Integer
    Dim i As Long
    Dim j As Long
    Dim k As Long

With Sheets("Sheet1")
        Set rng = .Range("A2", "F" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With

For i = 1 To rng.Rows.Count
        myval = rng.Rows(i).SpecialCells(xlCellTypeConstants).Cells.Value
        n = rng.Rows(i).SpecialCells(xlCellTypeConstants).Cells.Count
        With Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            For j = 3 To n
                .Offset(k, 0).Value = myval(1, 1)
                .Offset(k, 1).Value = myval(1, 2)
                .Offset(k, 2).Value = myval(1, j)
                k = k + 1
            Next j
            k = 0
        End With
    Next i

EXCELの表の展開の仕方を教えてください（VBAを利用？）

こんにちは！

Sheet2!A2: =OFFSET(Sheet1!$A$2,(ROW(A1)-1)/4,COLUMN(A1)-1)

VBAの例です。

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング