Hücrede tekrarlananları teke indirmek - Diziden mükerrer kayıtları silmek

[ExcelSitesi]

Aşağıdaki kod ile aynı hücre içinde tekrar eden verileri, satır satır tarayarak teke indirebiliriz:

Kod Seç Expand

Sub ExcelSitesiTekrarlariSil()
   Dim arr1, arr2
   For bulent = 1 To ActiveSheet.Range("A65530").End(3).Row
       arr1 = VBA.Split(Range("A" & bulent).Value, " ")
       arr2 = removeDuplicates(arr1)
       Range("B" & bulent).Value = Join(arr2, " ")
   Next bulent
End Sub

Function removeDuplicates(ByVal myArray As Variant) As Variant
Dim d As Object
Dim v As Variant
Dim outputArray() As Variant
Dim i As Integer

Set d = CreateObject("Scripting.Dictionary")
For i = LBound(myArray) To UBound(myArray)
   d(myArray(i)) = 1
Next i
i = 0
For Each v In d.Keys()
   ReDim Preserve outputArray(0 To i)
   outputArray(i) = v
   i = i + 1
Next v
removeDuplicates = outputArray
End Function