VBAマクロを自動作成する無料アプリ

VBAコードの知識不要😊ChatGPTで機能を追加

MENU

【ノーコード】既存データは上書き、新規データは追加する

エクセルVBAマクロを自動作成する無料アプリです。

例として「既存データは上書き新規データは追加する」VBAマクロを作成します。

事例 既存データは上書き、新規データは追加します

・左と右の表の1列目と2列目が同じときは、上書きします。

・左の表の1列目と2列目が、右の表に無いときは、新規として末尾に追加します。

マクロを実行すると、データに反映されました。

できました😄

【特徴】
条件転記は、セル・複数セルとも対応します(事例は複数セル)
2つの表のサイズが異なっても対応します。
列の順番は変えられます。
別シートや、複数シートへの転記も可能です。

 

なお、値が一致したら転記のパターンは下記があります😊

パターンを見る

値が一致したら、1行すべてを転記する|連想配列|連想配列

値が一致しなければ、1行すべてを転記する|連想配列

値が一致したら、値の横にデータを転記する|連想配列

値が一致したら、値の横で既存データは上書きし、新規データは追加する|連想配列

値が部分一致したら、データを転記する|フィルター

複数項目を、それぞれ異なる条件で転記する|フィルターオプション

 

【ポイント】
条件転記の列は、複数にも対応します。
2つの表のサイズが異なっても対応します。
列の順番は変えられます。
別シートや、複数シートへの転記も可能です。

 

アプリの設定

アプリのトップページ

 ⇒▼転記・上書き・新規追加・比較

 ⇒【ツール】値が一致したら既存データは上書き、新規データは追加

表示されるVBAコード 

アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。

 

VBAコードを見る

Sub デモ() '値が一致したら既存データは上書き、新規データは追加
 Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止 
'辞書オブジェクトの作成
    Dim 辞書1 As Object, 辞書2 As Object
    Set 辞書1 = CreateObject("Scripting.Dictionary")
    Set 辞書2 = CreateObject("Scripting.Dictionary")
'転記元の設定
    Sheets("Sheet1").Select
    Dim 最終行 As Long, 対象セル As Range
    最終行 = Cells(Rows.Count, Range("a3").Column).End(xlUp).Row
    Set 対象セル = Range("a3" & ":" & Cells(最終行, Range("d3").Column).Address(False, False))
'辞書1の作成
    Dim 行 As Range, key1 As Variant
    For Each 行 In 対象セル.Rows
        key1 = 行.Cells(1, 1) & "|" & 行.Cells(1, 2)
        If 辞書1.Exists(key1) Then
            行.Select
            MsgBox "選択した箇所に重複があるので終了します"
            Exit Sub
        Else
            辞書1(key1) = 行.Cells(1, 3) & "|" & 行.Cells(1, 4)
        End If
    Next
'転記先シートの選択
    Sheets("Sheet1").Select
'転記先セルの設定
    Dim 最終行2 As Long
    最終行2 = Cells(Rows.Count, Range("f3").Column).Offset(0, 1 - 1).End(xlUp).Row
    Set 対象セル = Range("f3" & ":" & Cells(最終行2, Range("i3").Column).Address(False, False))
'既存上書き
    Dim key2 As Variant
    For Each 行 In 対象セル.Rows
        key2 = 行.Cells(1, 1) & "|" & 行.Cells(1, 2)
        If 辞書2.Exists(key2) Then
            行.Select
            MsgBox "選択した箇所に重複があるので終了します"
            Exit Sub
        Else
            辞書2(key2) = ""
            Dim 値 As Variant
            If 辞書1.Exists(key2) Then
                値 = Split(辞書1(key2), "|")
                 行.Cells(1, 3) = 値(0)
                 行.Cells(1, 4) = 値(1)
            End If
        End If
    Next
'新規追加
     For Each key1 In 辞書1.Keys()
         If Not 辞書2.Exists(key1) Then
             最終行2 = 最終行2 + 1
                値 = Split(key1, "|")
                 Cells(最終行2, Range("f3").Column).Cells(1, 1) = 値(0)
                 Cells(最終行2, Range("f3").Column).Cells(1, 2) = 値(1)
                値 = Split(辞書1(key1), "|")
                 Cells(最終行2, Range("f3").Column).Cells(1, 3) = 値(0)
                 Cells(最終行2, Range("f3").Column).Cells(1, 4) = 値(1)
         End If
     Next key1
'Application.ScreenUpdatingとApplication.DisplayAlertsをTrueに戻す
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

ChatGPTで修正

あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です!

アプリはこちらから↓↓↓↓