ComboBox a benzersiz alfabetik sıralama

umitumit · 18 Aralık 2008

Sayfa1 de A sütununda A10:A100 arasında bir listem var.
istediğim şey ComboBox1 e bu listedeki verileri alfabetik olarak benzersiz sıralamak.
Yani aynı isimler bir defa listeye gelecek....

şimdiden ilgilenen arkadaşlara çok çok teşekkürler

ozgretmen · 18 Aralık 2008

Aşağıdaki kodu dener misiniz ?

Kod:

Private Sub UserForm_Initialize()
For x = 10 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A10:A" & x), Cells(x, 1)) = 1 Then
ComboBox1.AddItem Cells(x, 1).Value
End If
Next
End Sub

Korhan Ayhan · 18 Aralık 2008

Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.

Kod:

Option Explicit
 
Private Sub UserForm_Initialize()
    Dim X As Long
    Columns(256).Clear
    Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("IV1"), Unique:=True
    Columns(256).Sort Key1:=Range("IV1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    For X = 2 To [IV65536].End(3).Row
    ComboBox1.AddItem Cells(X, 256)
    Next
    Columns(256).Clear
End Sub

Orion1 · 18 Aralık 2008

Başka bir alternatif.

Dosya ektedir.

Kod:

Private Sub CommandButton1_Click()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
ComboBox1.Clear
With CreateObject("Scripting.Dictionary")
    For Each hcr In Range("A10:A" & Cells(65536, "A").End(xlUp).Row)
        If Not .exists(hcr.Value) Then
            .Add hcr.Value, Nothing
        End If
    Next hcr
a = .keys
End With
For i = LBound(a) To UBound(a) - 1
    For j = i + 1 To UBound(a)
        If StrComp(a(i), a(j)) = 1 Then
            x = a(j)
            a(j) = a(i)
            a(i) = x
        End If
    Next j
Next i
On Error Resume Next
ComboBox1.List = a
ComboBox1.ListIndex = 0
End Sub

umitumit · 19 Aralık 2008

SN Ozgretmen
SN KORHAN AYHAN
SN EVREN GİZLEN
çok teşekkür ederim.

şimdi gelelim günün sorusuna...
excel içindeki sayfalarda olan verilerimi önce bir sütunda;

=TOPLA.ÇARPIM((CD5<$CD$5:$CD$204)/EĞERSAY($CD$5:$CD$204;$CD$5:$CD$204&""))+1

ile, daha sonra bunun yanındaki sütunda;

=KÜÇÜK($CE$5:$CE$204;SATIR(CD1))

fonksiyonları ile küçükten büyüğe değer sıralaması yaptırıp daha sonra da yine yanındaki sütunda ;

{=İNDİS($CD$5:$CD$204;KÜÇÜK(EĞER($CE$5:$CE$204=CF5;SATIR($CE$5:$CE$204)-SATIR($CF$5)+1);EĞERSAY($CF$5:CF5;CF5)))}

kullanarak sıralıyorum. tabi bu da excelin epey bi hesaplaması ile oluyor.
yukarıdaki macro örneklerini görünce aklıma geldi.
acaba CD sütunundaki yaklaşık 1000 satırlık veriyi, macro benim için CF sütununa (sütun isimleri önemli değil, ben kendi dosyamdan kopyaladığım için CD falan oldu) sıralayabilir mi?

umitumit · 19 Aralık 2008

hoppalaaaaa....
hata oluştu. daha doğrusu ben yanlış anlattığım için hata oluştu.
alfabetik sıralama yapılacak veriler PAKET isimli sayfada mevcut.
ben ise combobox u diğer sayfalar içinde kullanıyorum.
şu an açık olan sayfaya göre A sütunundaki verileri sıralıyor.
oysa sadece PAKET isimli sayfanın A sütunundaki verileri sıralama yapmalı.
yani aşağıdaki macroda sayfayı sabitlememiz gerekiyor.

Private Sub CommandButton1_Click()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
ComboBox1.Clear
With CreateObject("Scripting.Dictionary")
For Each hcr In Range("A10:A" & Cells(65536, "A").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add hcr.Value, Nothing
End If
Next hcr
a = .keys
End With
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If StrComp(a(i), a(j)) = 1 Then
x = a(j)
a(j) = a(i)
a(i) = x
End If
Next j
Next i
On Error Resume Next
ComboBox1.List = a
ComboBox1.ListIndex = 0
End Sub

Orion1 · 19 Aralık 2008

Aşağıdakini deneyiniz

Kod:

Private Sub CommandButton1_Click()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
[B][COLOR="Red"]Dim pk As Worksheet[/COLOR][/B]
ComboBox1.Clear
[B][COLOR="red"]Set pk = Sheets("PAKET")[/COLOR][/B]
With CreateObject("Scripting.Dictionary")
For Each hcr In [B][COLOR="red"]pk.[/COLOR][/B]Range("A10:A" & [B][COLOR="red"]pk.[/COLOR][/B]Cells(65536, "A").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add hcr.Value, Nothing
End If
Next hcr
a = .keys
End With
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If StrComp(a(i), a(j)) = 1 Then
x = a(j)
a(j) = a(i)
a(i) = x
End If
Next j
Next i
On Error Resume Next
ComboBox1.List = a
ComboBox1.ListIndex = 0
End Sub

umitumit · 19 Aralık 2008

olmadı sn evren gizlen

bi saniye bi saniyeeeee....
aşağıdaki pk. ları görmemişim.
bi deneme daha yapayım bakayım

tamamdııırrrrr....
teşekkür ederim

Orion1 · 19 Aralık 2008

umitumit' Alıntı:
olmadı sn evren gizlen

bi saniye bi saniyeeeee....
aşağıdaki pk. ları görmemişim.
bi deneme daha yapayım bakayım

tamamdııırrrrr....
teşekkür ederim

Rica ederim.
İyi çalışmalar.

Tarkan VURAL · 19 Aralık 2008

Ben nedense her zaman ADO ile bunları yapmak tarafındayım.

Daha mı kolayıma geliyor ne ?

A sütununda karışık harfli iller yazılı olduğunu farz ettim ve aşağıdaki sorgu ile sıralatarak comboya aldık, daha hızlı oldu gibi...

Kod:

Set rs = con.Execute("select distinct iller from [Sayfa1$]")
If Not rs.EOF Then ComboBox1.Column = rs.getrows

umitumit · 22 Aralık 2008

herkese yardımlarından ötürü çok teşekkürler
şimdi gelelim günün sorusuna...
excel içindeki sayfalarda olan verilerimi önce bir sütunda;

=TOPLA.ÇARPIM((CD5<$CD$5:$CD$204)/EĞERSAY($CD$5:$CD$204;$CD$5:$CD$204&""))+1

ile, daha sonra bunun yanındaki sütunda;

=KÜÇÜK($CE$5:$CE$204;SATIR(CD1))

fonksiyonları ile küçükten büyüğe değer sıralaması yaptırıp daha sonra da yine yanındaki sütunda ;

{=İNDİS($CD$5:$CD$204;KÜÇÜK(EĞER($CE$5:$CE$204=CF5 ;SATIR($CE$5:$CE$204)-SATIR($CF$5)+1);EĞERSAY($CF$5:CF5;CF5)))}

kullanarak sıralıyorum. tabi bu da excelin epey bi hesaplaması ile oluyor.
yukarıdaki macro örneklerini görünce aklıma geldi.
acaba CD sütunundaki yaklaşık 1000 satırlık veriyi, macro benim için CF sütununa (sütun isimleri önemli değil, ben kendi dosyamdan kopyaladığım için CD falan oldu) sıralayabilir mi?

--------------------------------------------------------------------------------

baydeniro · 7 Ağustos 2012

Sayı Korhan Ayhan eski bir konu, ancak güzel bir çalışma. Listede yazılan harflere uygun olanları kalması, diğerlerinin gözükmemesi nasıl sağlanır.

umitumit · 14 Temmuz 2015

Eskilerden bulduğum bu konu hakkında tekrar yardıma ihtiyacım var arkadaşlar.

BASIM isimli sayfamın J61:J671 satırları arasındaki hücreleri benzersiz ve alfabetik olarak combobox1 e getirmek istiyorum.

Aşağıdaki macro yu kullanmaya çalışıyorum ama olmuyor.

Hata nerdedir?

Private Sub Combobox1_Click()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
Dim pk As Worksheet
ComboBox1.Clear
Set pk = Sheets("BASIM")
With CreateObject("Scripting.Dictionary")
For Each hcr In pk.Range("j61:j" & pk.Cells(671, "j").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add hcr.Value, Nothing
End If
Next hcr
a = .keys
End With
For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If StrComp(a(i), a(j)) = 1 Then
x = a(j)
a(j) = a(i)
a(i) = x
End If
Next j
Next i
On Error Resume Next
ComboBox1.List = a
ComboBox1.ListIndex = 0
End Sub

Korhan Ayhan · 14 Temmuz 2015

Foruma kod eklerken lütfen code (#) tagını kullanın. Daha düzenli görünecektir.

Kodun içindeki aşağıdaki satırı güncelleyin.

Eski hali;

Kod:

For Each hcr In pk.Range("j61:j" & pk.Cells(671, "j").End(xlUp).Row)

Yeni hali;

Kod:

For Each hcr In pk.Range("j61:j671")

veyselemre · 14 Temmuz 2015

Kod:

Private Sub ComboBox1_Enter()
    Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
    Dim pk As Worksheet
    ComboBox1.Clear
    Set pk = Sheets("BASIM")
    With CreateObject("Scripting.Dictionary")
        .comparemode = vbTextCompare
        For Each hcr In pk.Range("j61:j" & pk.Cells(671, "j").End(xlUp).Row)
            If Not .exists(hcr.Value) Then
                .Add hcr.Value, Nothing
            End If
        Next hcr
        a = .keys
    End With

    For i = LBound(a) To UBound(a) - 1
        For j = i + 1 To UBound(a)
            If StrComp(a(i), a(j), vbTextCompare) = 1 Then
                x = a(j)
                a(j) = a(i)
                a(i) = x
            End If
        Next j
    Next i
    On Error Resume Next
    ComboBox1.List = a
    ComboBox1.ListIndex = 0

End Sub

umitumit · 14 Temmuz 2015

Sayın Korhan Ayhan,

Sizin düzeltmeniz nedenini bilmemekle birlikte, çalışmadı.
Cevabınız için elinize sağlık.

Sayın Veysel Emre,

Sizin öneriniz çalıştı ve gayet başarılı.
Teşekkürler, emeğinize sağlık.

exekadir · 24 Temmuz 2015

Arkaşlar çok faydalı oldu teşekkür ederim.
Bir sorum olacak;
Bu formülleri ; Forma değil de Sayfaya eklenen Combobox lara nasıl uygularız.

exekadir · 24 Temmuz 2015

Aşağıdaki koda alfabetik sıralama eklenebilirmi

Private Sub UserForm_Initialize()
For x = 11 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A11:A" & x), Cells(x, 1)) = 1 Then
ComboBox1.AddItem Cells(x, 1).Value
End If
Next
End Sub

umitumit · 11 Ağustos 2015

Arkadaşlar merhaba,

Sizler sayesinde yazılan ve kullandığım aşağıdaki macroyu aynı dosyanın "GIRIS" sayfasının e4:e100 sütununa uyarlamak istedim, başarılı olamadım. Nerede hata yaptım acaba?

BASIM sayfasının çalışan macrosu;

Private Sub ComboBox1_Enter()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
Dim pk As Worksheet
ComboBox1.Clear
Set pk = Sheets("BASIM")
With CreateObject("Scripting.Dictionary")
.comparemode = vbTextCompare
For Each hcr In pk.Range("j61:j" & pk.Cells(671, "j").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add hcr.Value, Nothing
End If
Next hcr
a = .keys
End With

For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If StrComp(a(i), a(j), vbTextCompare) = 1 Then
x = a(j)
a(j) = a(i)
a(i) = x
End If
Next j
Next i
On Error Resume Next
ComboBox1.List = a
ComboBox1.ListIndex = 0

End Sub

"GIRIS" sayfasına kopyaladığım ama sadece E sütununun ilk hücresini gösteren macrom;

Private Sub ComboBox2_Enter()
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
Dim pk As Worksheet
ComboBox2.Clear
Set pk = Sheets("GIRIS")
With CreateObject("Scripting.Dictionary")
.comparemode = vbTextCompare
For Each hcr In pk.Range("e4:e" & pk.Cells(100, "e").End(xlUp).Row)
If Not .exists(hcr.Value) Then
.Add hcr.Value, Nothing
End If
Next hcr
a = .keys
End With

For i = LBound(a) To UBound(a) - 1
For j = i + 1 To UBound(a)
If StrComp(a(i), a(j), vbTextCompare) = 1 Then
x = a(j)
a(j) = a(i)
a(i) = x
End If
Next j
Next i
On Error Resume Next
ComboBox2.List = a
ComboBox2.ListIndex = 0

End Sub

ve aynı macroyu sayısal verilerin sıralamasında kullanmak için ne yapmalıyım?

Korhan Ayhan · 12 Ağustos 2015

Aşağıdaki gibi deneyiniz.

Kod bende çalıştı. Sadece sayısal sıralama olayını düzelttim.

Kod:

Private Sub ComboBox2_Enter()
    Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant, pk As Worksheet
    
    ComboBox2.Clear
    Set pk = Sheets("GIRIS")
    
    With CreateObject("Scripting.Dictionary")
        .comparemode = vbTextCompare
        For Each hcr In pk.Range("e4:e" & pk.Cells(100, "e").End(xlUp).Row)
            If Not .exists(hcr.Value) Then
                .Add hcr.Value, Nothing
            End If
        Next hcr
        a = .keys
    End With
    
    For i = LBound(a) To UBound(a) - 1
        For j = i + 1 To UBound(a)
            If a(i) > a(j) Then
                x = a(j)
                a(j) = a(i)
                a(i) = x
            End If
        Next j
    Next i
    
    On Error Resume Next
    ComboBox2.List = a
    ComboBox2.ListIndex = 0
End Sub

ComboBox a benzersiz alfabetik sıralama

umitumit

ozgretmen

Korhan Ayhan

Administrator

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

umitumit

umitumit

Orion1

Uzman

umitumit

Orion1

Uzman

Tarkan VURAL

umitumit

baydeniro

umitumit

Korhan Ayhan

Administrator

veyselemre

Özel Üye

umitumit

exekadir

exekadir

umitumit

Korhan Ayhan

Administrator