エクセルVBAマクロを自動作成する無料アプリです。
例として、アプリで「データの文字列や〇印を既存のクロス表にいれる」VBAマクロを作成します。
（ページの末尾に、VBAコード掲載）
事例 右側のクロス表に、文字列を転記する
マクロを実行すると、離れたセルの値がリスト化されました。
１０月３日のシフトBが、空いていることがわかります。
また、ダブりもメッセージを出すことができます。
アプリの設定
アプリのトップページ
⇒▼表形式の変換
⇒リスト形式を
⇒【ツール】縦のリスト形式のデータを、既存のマトリックス表に転記する
【ポイント】
■ 【４】リストの見出しが重複するときは、エラーメッセージを出して、中止できます。
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ_126() '縦のリスト形式のデータを、既存のマトリックス表に転記する
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止Dim リスト As Variant, 行見出し As Range, 列見出し As Range
Dim j As Long, 行 As Long, 列 As Long
'リストを配列に入れる
Worksheets("データ").Select
リスト = Range("a1").CurrentRegion.Value
'見出しを取得する
Worksheets("データ").Select
Set 行見出し = Range(Range("f2").Offset(0, -1), Range("f2").Offset(0, -1).End(xlDown))
Set 列見出し = Range(Range("f2").Offset(-1, 0), Range("f2").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
'重複チェック
Dim 辞書 As Object
Set 辞書 = CreateObject("Scripting.Dictionary")
Worksheets("データ").Select
For 行 = LBound(リスト, 1) To UBound(リスト, 1)
If 辞書.Exists(リスト(行, 1) & リスト(行, 2)) Then
MsgBox リスト(行, 1) & リスト(行, 2) & vbCrLf & "が重複しています。" & vbCrLf & "終了します"
Exit Sub
Else
辞書.Add リスト(行, 1) & リスト(行, 2), ""
End If
Next 行
辞書.RemoveAll
'既存データクリア
On Error Resume Next '空白対策
Worksheets("データ").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チャット」でコードを修正します。とても簡単です！
