指定範囲内の重複削除

Sub RemoveDuplicatesInSelection()
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
    Dim words() As String
    Dim i As Integer
    
    ' 選択範囲を取得
    Set rng = Selection
    
    ' ユニークな単語を格納するための辞書を作成
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 選択範囲内の各セルに対して処理を行う
    For Each cell In rng
        ' セルのテキストを結合して単語ごとに分割
        words = Split(cell.Value, " ")
        
        ' 分割された単語に対して処理
        For i = LBound(words) To UBound(words)
            ' 辞書に単語が存在しない場合のみ追加
            If Not dict.exists(words(i)) Then
                dict.Add words(i), Nothing
            End If
        Next i
    Next cell
    
    ' オリジナルの選択範囲をクリア
    rng.ClearContents
    
    ' 辞書内のユニークな単語を選択範囲に出力
    rng.Cells(1, 1).Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.keys)
End Sub