シートAから文字を読み取り、シートBに存在しない一意の文字リストを追加する

Sub prcAppendUniqueNames()
    ' 機能概要: シートAから文字を読み取り、シートBにまだ存在しない一意の文字を追記する

    Dim rngSource As Range
    Dim rngCell As Range
    Dim dicExistingNames As Scripting.Dictionary
    Dim dicUniqueNames As Scripting.Dictionary
    Dim wsSource As Worksheet
    Dim wsDestination As Worksheet
    Dim lngLastRowSource As Long
    Dim lngLastRowDestination As Long
    Dim strName As String

    ' ソースとデスティネーションのワークシートを初期化
    Set wsSource = ThisWorkbook.Worksheets("SheetA")
    Set wsDestination = ThisWorkbook.Worksheets("SheetB")

    ' ソースデータとデスティネーションデータの最終行を特定
    lngLastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    lngLastRowDestination = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row

    ' ソースとデスティネーション範囲を定義
    Set rngSource = wsSource.Range("A1:A" & lngLastRowSource)

    ' 既存の文字と新しい一意の文字を保存するための辞書オブジェクトを作成
    Set dicExistingNames = New Scripting.Dictionary
    Set dicUniqueNames = New Scripting.Dictionary

    ' 既存の文字を辞書に追加
    If lngLastRowDestination > 0 Then
        Dim rngDestination As Range
        Set rngDestination = wsDestination.Range("A1:A" & lngLastRowDestination)
        For Each rngCell In rngDestination
            strName = rngCell.Value
            If Not dicExistingNames.Exists(strName) Then
                dicExistingNames.Add strName, strName
            End If
        Next rngCell
    End If

    ' ソース範囲内の各セルに対してループし、新しい一意の文字を追加
    For Each rngCell In rngSource
        strName = rngCell.Value
        If Not dicExistingNames.Exists(strName) And Not dicUniqueNames.Exists(strName) Then
            dicUniqueNames.Add strName, strName
        End If
    Next rngCell

    ' 新しい一意の文字をデスティネーションシートに追記
    If dicUniqueNames.Count > 0 Then
        wsDestination.Range("A" & lngLastRowDestination + 1).Resize(dicUniqueNames.Count).Value = Application.Transpose(dicUniqueNames.Items)
    End If

    ' 後処理
    Set dicExistingNames = Nothing
    Set dicUniqueNames = Nothing
    Set rngSource = Nothing
    Set wsSource = Nothing
    Set wsDestination = Nothing
End Sub