エクセルVBAマクロを自動作成する無料アプリです。
例として「値が一致したら、複数列ある値の横にデータを転記する」VBAマクロを作成します。
事例 品名と産地が一致したら、単価を転記先１と転記先２に転記する
できました😊
なお、値が一致したら転記のパターンは下記があります😊
パターンを見る
値が一致しなければ、１行すべてを転記する｜連想配列
値が一致したら、値の横にデータを転記する｜連想配列
値が一致したら、値の横で既存データは上書き、新規データは追加｜連想配列
値が部分一致したら、データを転記する｜フィルター
複数項目を、それぞれ異なる条件で転記する｜フィルターオプション
アプリの設定
アプリへのリンク ⇒値が一致したら転記する（値の横に）
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ() '値が一致したら転記する
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
'辞書オブジェクトの作成
Dim 辞書 As Object
Set 辞書 = CreateObject("Scripting.Dictionary")
'転記元の設定
Sheets("Sheet1").Select
Dim 最終行 As Long, 表セル As Range
最終行 = Cells(Rows.Count, Range("A2").Column).End(xlUp).Row
Set 表セル = Range("A2" & ":" & Cells(最終行, Range("B2").Column).Address(False, False))
'辞書の作成
Dim キー As Variant, 対象行 As Range
For Each 対象行 In 表セル.Rows
キー = 対象行.Cells(1, 1)
If 辞書.Exists(キー) Then
対象行.Select
MsgBox "選択した行に重複があるので終了します"
Exit Sub
Else
辞書(キー) = Array(対象行.Cells(1, 2))
End If
Next
Set 表セル = Nothing
'転記先 シートの選択
Sheets("Sheet1").Select
'対象を配列に入れる
Dim 対象配列() As Variant, 最終行2 As Long
最終行2 = Cells(Rows.Count, Range("D2").Column).Offset(0, 1 - 1).End(xlUp).Row
対象配列 = Range("D2" & ":" & Cells(最終行2, Range("I2").Column).Address(False, False)).Value
Dim 行 As Long, 列 As Long
For 列 = 1 To UBound(対象配列, 2) Step 2
For 行 = 1 To UBound(対象配列)
キー = 対象配列(行, 列 - 1 + 1)
If 辞書.Exists(キー) Then
対象配列(行, 列 - 1 + 2) = 辞書(キー)(0)
End If
Next 行
Next 列
'対象配列をシートに反映する
Sheets("Sheet1").Range("D2").Resize(UBound(対象配列), UBound(対象配列, 2)).Value = 対象配列
'Application.ScreenUpdatingとApplication.DisplayAlertsをTrueに戻す
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です！
