Option Explicit
Public Sub Test()
Debug.Print "[START]"
Dim dicTokenCache As Object
Set dicTokenCache = CreateObject("Scripting.Dictionary")
Dim dicTokens As Object
Dim rngCell As Excel.Range
Dim blnReplace As Boolean
Dim tokens As Variant
Dim token As Variant
Set rngCell = Range("A1")
Do While rngCell.Value <> ""
'Zelleninhalt => Array => Dictionary
tokens = Split(rngCell.Value, " ")
Set dicTokens = CreateObject("Scripting.Dictionary")
For Each token In tokens
dicTokens(token) = Empty
Next
'Zelleninhalt prüfen
For Each token In tokens
If dicTokenCache.Exists(token) = False Then
Call dicTokenCache.Add(Item:=rngCell.Address(0, 0), Key:=token)
Else
Debug.Print "["; rngCell.Address(0, 0); "] :: remove '"; token; _
"' (previously seen in: "; dicTokenCache(token); ")"
'das 'token' haben wir schon vorher mal gesehen
'=> 'token' entfernen
Call dicTokens.Remove(token)
blnReplace = True
End If
Next
'falls oben 'token' entfernt wurden,
'wird hier das Endergebnis zur in die Zelle geschrieben
If blnReplace Then
tokens = Join(dicTokens.Keys(), " ")
Debug.Print "["; rngCell.Address(0, 0); "] :: change '"; rngCell.Value; "' to '"; tokens; "'"
rngCell.Value = Join(dicTokens.Keys(), " ")
blnReplace = False
End If
Set rngCell = rngCell.Offset(1)
Loop
Debug.Print "[DONE]"
End Sub
|