エクセルVBAマクロを自動作成する無料アプリです。
例として「データを既存のマトリックス表に転記する」VBAマクロを作成します。
事例 縦のリスト形式のデータを、既存のクロス集計表に転記する
※ 下記事例は見出し行と列が複数項目ですが、1行、１列にも対応します。
アプリの設定
アプリへのリンク ⇒データを既存のマトリックス(クロス集計)表に転記
【ポイント】
■ リストの見出しが重複するときに、数字であれば加算や、エラーメッセージを出して中止も可能です。
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ() '縦のリスト形式のデータを、既存のマトリックス表に転記する
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Dim 辞書元 As Object, キー元 As String, セル As Range, 行 As Long
Set 辞書元 = CreateObject("Scripting.Dictionary")
Dim 辞書先 As Object, キー先 As String
Set 辞書先 = CreateObject("Scripting.Dictionary")
' 転記先辞書作成
Worksheets("Sheet1").Select
For Each セル In Range("I3:L5")
キー先 = Cells(セル.Row, "G") & "|" & Cells(セル.Row, "H") & "|" & Cells(1, セル.Column) & "|" & Cells(2, セル.Column)
辞書先(キー先) = ""
Next
' 転記元をループし、転記先辞書に転記元のキーが無い場合エラー終了、あれば転記元辞書に値
Worksheets("Sheet1").Select
For 行 = 2 To Cells(Rows.Count, "A").End(xlUp).Row
キー元 = Cells(行, "A") & "|" & Cells(行, "B") & "|" & Cells(行, "C") & "|" & Cells(行, "D")
If Not 辞書先.Exists(キー元) Then
MsgBox "エラー:選択した組み合わせが転記先に存在しません"
Union(Cells(行, "A"), Cells(行, "B"), Cells(行, "C"), Cells(行, "D")).Select
Exit Sub
Else
If Not 辞書元.Exists(キー元) Then
辞書元(キー元) = Cells(行, "E")
Else
辞書元(キー元) = 辞書元(キー元) + Cells(行, "E")
End If
End If
Next 行
'既存データクリア
Worksheets("Sheet1").Range("I3:L5").ClearContents
'転記先に転記元の値を転記
Worksheets("Sheet1").Select
For Each セル In Range("I3:L5")
セル.Value = 辞書元(Cells(セル.Row, "G") & "|" & Cells(セル.Row, "H") & "|" & Cells(1, セル.Column) & "|" & Cells(2, セル.Column))
Next
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です！
