シートAのテキストがシートBのテキストマスタに存在しない場合はテキストマスタに新規登録する

Sub AddNewTextsToMasterUsingDictionary()
    ' ライブラリ参照設定済み: Microsoft Scripting Runtime
    Dim wsSource As Worksheet
    Dim wsMaster As Worksheet
    Dim dictMaster As Scripting.Dictionary
    Dim cell As Range
    Dim textValue As String
    Dim lastRowMaster As Long
    
    ' ワークシートの設定
    Set wsSource = ThisWorkbook.Sheets("シートA")
    Set wsMaster = ThisWorkbook.Sheets("シートB")
    
    ' Dictionaryオブジェクトの初期化
    Set dictMaster = New Scripting.Dictionary
    
    ' シートBから既存のテキストマスタをDictionaryに読み込む
    lastRowMaster = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row
    For Each cell In wsMaster.Range("A1:A" & lastRowMaster)
        If Not dictMaster.Exists(cell.Value) Then
            dictMaster.Add cell.Value, Nothing
        End If
    Next cell
    
    ' シートAのテキストを確認し、Dictionaryにない場合はシートBに追加
    For Each cell In wsSource.Range("A1:A" & wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row)
        textValue = cell.Value
        If Len(textValue) > 0 And Not dictMaster.Exists(textValue) Then
            ' Dictionaryにテキストが存在しない場合、シートBとDictionaryに追加
            lastRowMaster = lastRowMaster + 1
            wsMaster.Cells(lastRowMaster, "A").Value = textValue
            dictMaster.Add textValue, Nothing
        End If
    Next cell
End Sub

コメント