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

質問

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

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

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

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

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

よろしくお願いします。

回答No.3

tom04 · ベストアンサー

こんにちは！
一例です。
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

お礼

ありがとうございました！
頂いたコードで目的の結果が得られました。

VBAはまだまだ初心者ですが、頂いたサンプルコードを1行1行確認させていただき
勉強していきたいと思います。

明日、出社して早速作業ができそうです。

本当にありがとうございました。

回答No.2

noname#204879

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）

お礼

なるほど～！
こういう方法もあるんですね。
とても参考になりました。

今回の例ではC列からF列までの4列にに商品が入っているので「4」という定数が
使われていると思いますが、（今回のMAXは20列なので）「20」を入れてフィルタで
抽出すれば求める結果も得られますね。

ありがとうございました。

回答No.1

xls88

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

補足

ありがとうございます。
サンプルのシートで変換できました。

1点、今回のシートはデータがF列までなので、下記のように指定されていると
思うのですが、実際は任意列（20以下ですが）までデータが入っています。

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

この場合、それぞれの行で最終列をカウントしその範囲を指定となりますが
どのように記述を変更すればよいか教えていただけないでしょうか？

せっかくですので、頂いたサンプルコードでも実行したいと思っています。
よろしくお願いします。