無料アプリで、すぐに、エクセルVBAマクロを作成できます。
例として、「マトリックス表（ピボット）をリスト形式にする」VBAマクロを作成します。
（ページの末尾に、VBAコード掲載）
事例
ピボットテーブル形式の表を、リスト形式にもどします。
注： ピボットテーブル機能は、値貼り付けで、解除してください。
マクロを実行すると、リスト形式になりました。
できました(^^)/
アプリの設定
アプリのトップページ
⇒▼表形式の変換
⇒リスト形式へ
⇒【ツール】マトリックス表（ピボット形式）を、縦のリスト形式に転記
【ポイント】
■ 行数が変わるデータの、最終行まで処理できます。
■ 同じシート上や、別シートにリストを作成できます。
■ データは、横方向か縦方向を、優先できます。
■ 結合の解除や、空白を埋める設定ができます。
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
Sub デモ_11() '縦のリスト形式にする
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Dim 元シート As Worksheet, 先シート As Worksheet, 左上行 As Long, 左端列 As Long
Dim 右端列 As Long, 右下行 As Long, 表左上列 As Long, 表左上行 As Long
'◆初期値の設定
Set 元シート = Worksheets("Sheet1")
左上行 = 元シート.Range("c3").Row
左端列 = 元シート.Range("c3").Column
表左上行 = 元シート.Range("c3").End(xlUp).Row
表左上列 = 元シート.Range("c3").End(xlToLeft).Column
元シート.Select
元シート.Range("c3").CurrentRegion.Select
右下行 = Selection(Selection.Count).Row
右端列 = Selection(Selection.Count).Column
'◆左上セルチェック
If 元シート.Range("c3").Cells.Count > 1 Or 左上行 = 表左上行 Or 左端列 = 表左上列 Then
MsgBox "(見出しを除いた)データ領域の左上セルを一つ選択してください"
Exit Sub
End If
Dim セル As Range, 値 As Range
'◆結合を解除
For Each セル In Union(Range(Cells(左上行, 左端列 - 1), Cells(右下行, 表左上列)), Range(Cells(表左上行, 左端列), Cells(左上行 - 1, 右端列)))
If セル.MergeCells Then
With セル.MergeArea
.UnMerge
.Value = .Resize(1, 1).Value
End With
End If
Next セル
'◆表を2次元配列に格納
Dim 表データ As Variant, データ1列 As Variant, データ全列 As Variant, 現在列 As Long, 元の列数 As Long
表データ = 元シート.Range(Cells(左上行, 左端列), Cells(右下行, 右端列))
'◆２次元配列を1列づつ、１次元配列へ格納
For 元の列数 = 1 To 右端列 - 左端列 + 1
データ1列 = WorksheetFunction.Index(WorksheetFunction.Transpose(表データ), 元の列数)
'データ全列に、各データ1列を結合。区切り文字は改行のvbCrLf
If 元の列数 = 1 Then
データ全列 = Split(Join(データ1列, vbCrLf), vbCrLf)
Else
データ全列 = Split(Join(データ全列, vbCrLf) & vbCrLf & Join(データ1列, vbCrLf), vbCrLf)
End If
Next 元の列数
Set 先シート = Worksheets("sheet2")
'◆行見出しコピー
元シート.Range(Cells(左上行, 表左上列), Cells(右下行, 左端列 - 1)).Copy
先シート.Range("a1").Resize(UBound(データ全列) + 1, 1).PasteSpecial Paste:=xlPasteAll
'列を左から右に
先シート.Select
先シート.Range("a1").Offset(0, 左端列 - 表左上列).Resize(右下行 - 左上行 + 1, 1).Select
For 現在列 = 左端列 To 右端列
'◆列見出しコピー
元シート.Select
元シート.Range(Cells(表左上行, 現在列), Cells(左上行 - 1, 現在列) ).Copy
先シート.Select
Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
Selection.Offset((右下行 - 左上行 + 1), 0).Select
Next
'◆データ全行を、1列に書き込み
先シート.Range("a1").Offset(0, (左端列 - 表左上列) +左上行 - 表左上行).Resize(UBound(データ全列) + 1, 1).Value _
= WorksheetFunction.Transpose(データ全列)
'◆データ全行に書式
元シート.Select
元シート.Cells(右下行, 右端列).Copy
先シート.Range("a1").Offset(0, (左端列 - 表左上列) + (左上行 - 表左上行) ).Resize(UBound(データ全列) + 1, 1).PasteSpecial Paste:=xlPasteFormats
先シート.Select
Application.CutCopyMode = False
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
マクロを使うメリット
手作業で数分かかる作業が、1秒で終わります。
ぜひ、アプリをご利用ください。