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
コメント