Soru Mükerrer olanları tek alma

[sirkülasyon]

Dim DİZİD As New Collection, HÜCRED As Range, VERİD As Variant
   On Error Resume Next
    For Each HÜCRED In Sheets("DATA").Range("F2:F" & Range("F65536").End(3).Row)
    DİZİD.Add HÜCRED.Value, CStr(HÜCRED.Value)
    Next
    On Error GoTo 0
    For Each VERİD In DİZİD
        ComboBox5.AddItem VERİD
    Next

Data sayfasında F2:F aralığında olan hücrelerde ki isimleri combobox5' e mükerrer olarak alıyor.
Örnek
a
a
a
a
b
b
b
c
c
c
olarak alıyor. Bunu
a
b
c
şeklinde alması için ne yapabilirim?

 

[byfika]

Merhabalar,
Private Sub UserForm_Initialize()
Dim i As Long, son As Long, a(), dc As Object
ComboBox5.Clear
son = Range("f" & Rows.Count).End(xlUp).Row
Set dc = CreateObject("scripting.dictionary")
If son > 1 Then
a = Range("f2:f" & son).Value
For i = 1 To UBound(a)
If Not IsEmpty(a(i, 1)) Then dc(a(i, 1)) = ""
Next i
End If
If dc.Count > 0 Then
UserForm1.ComboBox5.List = dc.Keys
End If
End Sub

Kodu dener misiniz?

 

[sirkülasyon]

DATA haricinde ki bir başka sayfada işlem yapınca

Dim DİZİD As New Collection, HÜCRED As Range, VERİD As Variant
   On Error Resume Next
    For Each HÜCRED In Sheets("DATA").Range("F2:F" & Range("F65536").End(3).Row)
    DİZİD.Add HÜCRED.Value, CStr(HÜCRED.Value)
    Next
    On Error GoTo 0
    For Each VERİD In DİZİD
        ComboBox5.AddItem VERİD
    Next

mükerrer çözüldü ancak bu sefer de veriyi almıyor.