MENU

新規データは表に追加、既存データは上書する

エクセルVBAマクロを、簡単に作成してみませんか?

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

処理のイメージ

事例

左側のに、右側のデータを反映します。

データの、通し番号が重複するときは、上書きします。

・重複しないときは、新規として末尾に追加し、通し番号を付与します。

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

できました(^^)/

通し番号とは

通し番号は、重複しないデータの検索キーで、伝票番号やシーケンス番号などです。文字列も使えます。

アプリの設定

アプリの設定です。

トップページ ⇒データベースの上書更新・新規追加 ⇒表の上書更新・新規追加

見出しは、データを、同一にしてください

データのシートは、異なってもよいです。

処理前データでキーが重複する場合、そのセルが選択され、処理が終了します。

複数列の組み合わせでキーを作成できます。各セルを&で結び、キーを作ります。

表示されるVBAコード 

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

Sub デモ_13() 'データの上書更新・新規追加
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False  ' 警告表示を停止

Application.Calculation = xlCalculationManual '自動計算を停止
Dim データベース辞書 As Object, データ辞書 As Object, DBシート As Worksheet, dシート As Worksheet
Dim データベースkey As Variant, データkey As Variant, データベース行 As Long, データ行 As Long
Dim データベース最終行 As Long, データ最終行 As Long, 最大値 As Long, 数 As Long
Set データベース辞書 = CreateObject("Scripting.Dictionary")
Set データ辞書 = CreateObject("Scripting.Dictionary")
Set DBシート = Sheets("sheet1") 'データベースのあるシート
Set dシート = Sheets("sheet1") 'データのあるシート
'初期化
データ辞書.RemoveAll
データベース辞書.RemoveAll
数 = 1
'データベースの最終行取得
データベース最終行 = DBシート.Cells(Rows.Count, 1).End(xlUp).Row
For データベース行 = 2 + 1 To データベース最終行
    'キーをつくる
    データベースkey = DBシート.Cells(データベース行, 1).Value
    'キーが重複するときは、そのセルを選択して終了
    If データベース辞書.Exists(データベースkey) Then
        DBシート.Select
        DBシート.Cells(データベース行, 1).Select
        MsgBox "データベースのキーに重複があるので、終了します。"
        Exit Sub
    End If
    '◆キー列の値をkey 、行数をitem、とするデータベース辞書を作成
    データベース辞書.Add データベースkey, データベース行
Next
'データの最終行取得
Dim データ範囲 As Range
Set データ範囲 = dシート.Cells(2, 8).CurrentRegion
データ最終行 = データ範囲.Row + データ範囲.Rows.Count - 1
For データ行 = 2 + 1 To データ最終行
    'キー列が空白の場合、ダミーデータを入れる
    If dシート.Cells(データ行, 8 + 1 - 1).Value = "" Then
        dシート.Cells(データ行, 8 + 1 - 1).Value = "空白" & 数
        数 = 数 + 1
    End If
    'キーをつくる
    データkey = dシート.Cells(データ行, 8 + 1 - 1).Value
    'キーが重複するときは、そのセルを選択して終了
    If データ辞書.Exists(データkey) Then
            dシート.Select
            dシート.Cells(データ行, 8 + 1 - 1).Select
            MsgBox "データのキーに重複があるので、終了します。"
            Exit Sub
    End If
    '◆キー列の値をkey 、行全体の値をitem、とするデータ辞書を作成
    データ辞書.Add データkey, Array(データ行, Range(dシート.Cells(データ行, 8), dシート.Cells(データ行, 13)).Value)
Next
'◆各データ辞書のkeyで、全データベース辞書内のkeyをチェック
For Each データkey In データ辞書
    'データベースに、データkeyが既存の場合、データベース上書き
    If データベース辞書.Exists(データkey) Then
        データベース行 = データベース辞書.item(データkey)
        DBシート.Range(DBシート.Cells(データベース行, 1), DBシート.Cells(データベース行, 1 + 13 - 8)) = データ辞書.item(データkey)(1)
    Else
        'データベースに、データkeyがないの場合、データベースkeyの最大値+1でデータベースに新規登録
        データベース最終行 = DBシート.Cells(Rows.Count, 1).End(xlUp).Row
        最大値 = WorksheetFunction.Max(DBシート.Range(DBシート.Cells(2 + 1, 1), DBシート.Cells(データベース最終行, 1)))
        DBシート.Range(DBシート.Cells(データベース最終行 + 1, 1), DBシート.Cells(データベース最終行 + 1, 1 + 13 - 8)) = データ辞書.item(データkey)(1)
        DBシート.Cells(データベース最終行 + 1, 1).Value = 最大値 + 1
    End If
Next
'キー列のダミーデータを空白にもどす
For データ行 = 2 + 1 To データ最終行
    If dシート.Cells(データ行, 8 + 1 - 1).Value Like "空白*" Then
        dシート.Cells(データ行, 8 + 1 - 1).Value = ""
    End If
Next

Application.Calculation = xlCalculationAutomatic ' 自動計算を再開
Application.DisplayAlerts = True   ' 警告表示を再開
Application.ScreenUpdating = True  ' 画面描画を再開
End Sub

マクロを使うメリット

手作業で数分かかる作業が、1秒で終わります。

ぜひ、アプリをご利用ください。

 

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