エクセルVBAマクロを自動作成する無料アプリです。
例として「データを既存のマトリックス表に転記する」VBAマクロを作成します。
(ページの末尾に、VBAコード掲載)
事例 縦のリスト形式のデータを、既存のクロス集計表に転記する
なお、縦のリスト形式のデータから、新規のマトリックス(集計表)の作成は、エクセルの標準機能のピボットテーブルが簡単です。
アプリの設定
アプリのトップページ
⇒▼表形式の変換
⇒リスト形式を
⇒【ツール】縦のリスト形式のデータを、既存のマトリックス表に転記する
【ポイント】
■ リストの見出しが重複するときに、数字であれば加算や、エラーメッセージを出して中止も可能です。
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ_35() '縦のリスト形式のデータを、既存のマトリックス表に転記する
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止Dim リスト As Variant, 行見出し As Range, 列見出し As Range
Dim j As Long, 行 As Long, 列 As Long
'リストを配列に入れる
Worksheets("Sheet1").Select
リスト = Range("a1").CurrentRegion.Value
'見出しを取得する
Worksheets("Sheet2").Select
Set 行見出し = Range(Range("b2").Offset(0, -1), Range("b2").Offset(0, -1).End(xlDown))
Set 列見出し = Range(Range("b2").Offset(-1, 0), Range("b2").Offset(-1, 0).End(xlToRight))
'見出しに、項目の漏れがないかチェック
For j = 2 To UBound(リスト, 1)
If 行見出し.Find(リスト(j, 1)) Is Nothing Then
MsgBox リスト(j, 1) & vbCrLf & "が見出しにありません。" & vbCrLf & "見出しの漏れと位置を確認してください" & vbCrLf & "終了します"
Exit Sub
End If
If 列見出し.Find(リスト(j, 2)) Is Nothing Then
MsgBox リスト(j, 2) & vbCrLf & "が見出しにありません。" & vbCrLf & "見出しの漏れと位置を確認してください" & vbCrLf & "終了します"
Exit Sub
End If
Next j
'既存データクリア
On Error Resume Next '空白対策
Worksheets("Sheet2").Select
行見出し.Offset(0, 1).Resize(, 列見出し.Columns.Count).SpecialCells(xlCellTypeConstants, 3).ClearContents
On Error GoTo 0
'値を転記
For j = 2 To UBound(リスト, 1)
行 = 行見出し.Find(リスト(j, 1)).Row
列 = 列見出し.Find(リスト(j, 2)).Column
Cells(行, 列).Value = リスト(j, 3)
Next j
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!