【VBA×ChatGPT】1分でマクロを作り、1秒で処理完了

「VBAマクロを作成」するChatGPTプロンプトや、VBAコードを表示する無料アプリです。

MENU

マトリックス表(クロス・ピボット)をリスト形式にする

無料アプリで、すぐに、エクセルVBAマクロを作成できます。

例として、「マトリックス表(クロス表・ピボット)をリスト形式にする」VBAマクロを作成します。

(ページの末尾に、VBAコード掲載)

事例

ピボットテーブル形式の表を、リスト形式にもどします。

※ ピボットテーブル機能は、値貼り付けをして解除してください。

マクロを実行すると、リスト形式になりました。

できました!😀

 

アプリの設定

アプリのトップページ

 ⇒▼表形式の変換

 ⇒リスト形式へ

 ⇒【ツール】マトリックス表(ピボット形式)を、縦のリスト形式に転記

 



【ポイント】

 行数が変わるデータの、最終行まで処理できます。

 同じシート上や、別シートにリストを作成できます。

 データは、横方向か縦方向を、優先できます。

 結合の解除や、空白を埋める設定ができます。

 

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

Sub デモ() '縦のリスト形式にする 
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止 
Dim 元シート As Worksheet, 先シート As Worksheet, 左上行 As Long, 左端列 As Long
Dim 表左上行 As Long, 表左上列 As Long, 右下行 As Long, 右端列 As Long, セル範囲 As Range
'◆初期値の設定
Set 元シート = Worksheets("Sheet1")
Set 先シート = Worksheets("sheet2")
元シート.Select
左上行 = Range("d4").Row
左端列 = Range("d4").Column
表左上行 = Range("d4").End(xlUp).Row
表左上列 = Range("d4").End(xlToLeft).Column
Range("d4").CurrentRegion.Select
右下行 = Selection(Selection.Count).Row
右端列 = Selection(Selection.Count).Column
Set セル範囲 = Range(Cells(左上行, 左端列), Cells(右下行, 右端列))
Dim 見出し列 As Range, 見出し行 As Range
Set 見出し列 = Range(Cells(左上行, 左端列 - 1), Cells(右下行, 表左上列))
Set 見出し行 = Range(Cells(表左上行, 左端列), Cells(左上行 - 1, 右端列))
Dim セル As Range, セル1 As Range
'◆結合を解除
For Each セル In Union(見出し列, 見出し行)
    If セル.MergeCells Then
        With セル.MergeArea
            .UnMerge
            .Value = .Resize(1, 1).Value
        End With
    End If
Next セル
'◆空白に値を入れる
On Error Resume Next
Set セル = 見出し列.SpecialCells(xlCellTypeBlanks)
セル.FormulaR1C1 = "=R[-1]C"
見出し列.Value = 見出し列.Value
Set セル1 = 見出し行.SpecialCells(xlCellTypeBlanks)
セル1.FormulaR1C1 = "=RC[-1]"
見出し行.Value = 見出し行.Value
'◆表を2次元配列に格納
Dim 表データ As Variant, データ1列 As Variant, データ全列 As Variant, 現在列 As Long, 元の列数 As Long
表データ = セル範囲
'◆2次元配列を1列づつ、1次元配列へ格納
For 元の列数 = 1 To 右端列 - 左端列 + 1
    データ1列 = WorksheetFunction.Index(WorksheetFunction.Transpose(表データ), 元の列数)
    'データ全列に、各データ1列を結合。区切り文字は改行の"|"
    If 元の列数 = 1 Then
        データ全列 = Split(Join(データ1列, "|"), "|")
    Else
       データ全列 = Split(Join(データ全列, "|") & "|" & Join(データ1列, "|"), "|")
    End If
Next 元の列数
'◆見出し列コピー
元シート.Select
見出し列.Copy
先シート.Range("a1").Resize(UBound(データ全列) + 1, 1).PasteSpecial Paste:=xlPasteAll
'列を左から右に
先シート.Select
先シート.Range("a1").Offset(0, 左端列 - 表左上列).Resize*1.Copy
    先シート.Select
    Selection.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    Selection.Offset*2.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秒で終わります。

ぜひ、アプリをご利用ください。

 

アプリはこちらから↓↓↓↓ 

nocodevba.herokuapp.com

*1:右下行 - 左上行 + 1), 1).Select
For 現在列 = 左端列 To 右端列
    '◆見出し行コピー
    元シート.Select
    元シート.Range(Cells(表左上行, 現在列), Cells(左上行 - 1, 現在列

*2:右下行 - 左上行 + 1), 0).Select
Next
'◆データ全行を、1列に書き込み
先シート.Range("a1").Offset(0, (左端列 - 表左上列) + (左上行 - 表左上行