エクセルVBAマクロを自動作成する無料アプリです。
例として「データを、見出しの横に明細を繰り返す横持ち表にする」VBAマクロを作成します。
事例 データを、明細を横に繰り返す横持ち表にします
マクロを実行すると、明細が横に繰り返されます。
できました(^^)/
アプリの設定
アプリのトップページ
⇒▼表形式の変換
⇒リスト形式を
⇒【ツール】見出しの横に明細が繰り返される表にする
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ_6() '縦のリスト形式のデータを、横に明細が繰り返される表にする
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Application.Calculation = xlCalculationManual '自動計算を停止
Dim 対象辞書 As Object, 転記先辞書 As Object, 対象key As Variant, 対象シート As Worksheet, 転記先シート As Worksheet
Dim 転記先最終行 As Long, 転記列数 As Long, 対象最終行 As Long, 対象行 As Long, 転記先行 As Long, 転記先最終列 As Long
Set 対象辞書 = CreateObject("Scripting.Dictionary")
Set 転記先辞書 = CreateObject("Scripting.Dictionary")
Set 対象シート = Sheets("sheet1") '対象のシート
Set 転記先シート = Sheets("sheet2") '転記先のシート
'初期化
対象辞書.RemoveAll
転記先辞書.RemoveAll
転記先最終行 = 3
'転記部分の列数を取得
転記列数 = 対象シート.Cells(2, 3).End(xlToRight).Column - 3
'各対象を転記先に転記
対象最終行 = 対象シート.Cells(Rows.Count, 3).End(xlUp).Row
For 対象行 = 2 + 1 To 対象最終行
対象key = 対象シート.Cells(対象行, 3).Value
対象辞書.Add 対象key, Array(対象行, 対象シート.Cells(対象行, 3 + 1).Resize(1, 転記列数).Value)
If Not 転記先辞書.Exists(対象key) Then
転記先辞書.Add 対象key, 転記先最終行 + 1
転記先シート.Cells(転記先最終行 + 1, 2).Value = 対象key
転記先シート.Cells(転記先最終行 + 1, 2 + 1).Resize(1, 転記列数) = 対象辞書.Item(対象key)(1)
転記先最終行 = 転記先最終行 + 1
Else
転記先行 = 転記先辞書.Item(対象key)
転記先シート.Cells(転記先行, 2).End(xlToRight).Offset(, 1).Resize(1, 転記列数).Value = 対象辞書.Item(対象key)(1)
End If
対象辞書.RemoveAll
Next
'見出しのコピー
対象シート.Cells(2, 3).Copy
転記先シート.Cells(3, 2).PasteSpecial Paste:=xlPasteAll
With 転記先シート.Range("B2").CurrentRegion
転記先最終列 = .Column + .Columns.Count - 1
End With
対象シート.Cells(2, 3 + 1).Resize(1, 転記列数).Copy
転記先シート.Range(転記先シート.Cells(3, 2 + 1), 転記先シート.Cells(3, 転記先最終列)).PasteSpecial Paste:=xlPasteAll
転記先シート.Select
Application.Calculation = xlCalculationAutomatic ' 自動計算を再開
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です！
