• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Listbox çift isimleri teke düşürme sorunu

Katılım
16 Haziran 2007
Mesajlar
163
Excel Vers. ve Dili
Excel 2003 - Türkçe
herkese selamlar arkadaşlar ekteki dosyada listbox a sütunundaki isimleri listeleyerek gösteriyor ama aynı kişilere ait birçok kayıt olacağı için listboxta simlerin bir tane ve alfabetik sıralı gözükmesini bir türlü yapamadım yardımlarınıza ihtiyacım var şimdiden çok teşekkürler..
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Option Base 1
Sub listele()
Dim sat As Long, i As Long, liste(), x As Variant
Dim z As Object, a As Long, j As Long
liste() = Range("A11:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
ListBox1.Clear
Set z = CreateObject("Scripting.dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        a = a + 1
        z.Add liste(i, 1), Nothing
    End If
Next i
liste = Application.Transpose(Array(z.keys))
Set z = Nothing
For i = 1 To UBound(liste) - 1
    For j = i To UBound(liste)
        If StrComp(liste(i, 1), liste(j, 1)) = 1 Then
            x = liste(i, 1)
            liste(i, 1) = liste(j, 1)
            liste(j, 1) = x
        End If
    Next j
Next i
If a > 0 Then ListBox1.List = liste
Erase liste
End Sub
 

Ekli dosyalar

Çok teşekkür ederim üstadım ellerine emeğine sağlık...
 
Geri
Üst