CheckBox ile Listbox'da süzme işlemi

Katılım
18 Şubat 2009
Mesajlar
11
Excel Vers. ve Dili
ekxcell 2007
Sitenizi yaklaşık 3,4 yıldır takip ediyorum.Ancak bu güne kadar sorduğum hiçbir konuya yanıt alamadım.İnşaallah bu sefer şeytanın bacağını kıracağım diye düşünüyorum. Ekli dosyada userform1 üzerinde 2 adet ComboBox ve 2 adet ListBox nesnem var.ComboBox1'de sayfaları listeliyorum.Süzüme göre Listbox2ye sayfa başlıklarını alıyorum.Yapamadığım işleme gelince; ListBox2'de checkbox kutucuğunu onayladığımda ComboBox2'de satırdaki verileri benzersiz olarak listelemesi.Konu ile ilgili yaptığım araştırmalarda checkBoxla ListBox'da süzme işlemine ait bir örnek bulamadım.Eğer konu ile ilgili bildiğiniz bir örnek çalışma varsa ve beni yönlendirirseniz çok sevinirim.Saygılarımla,
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Formdaki tüm kodları silip aşağıdakileri yapıştırın. Yalnız verileri combobox da listeleyeceğiniz için listbox da son seçilen sütun indeksine göre işlem yaptırdım.

Kod:
Private Sub ComboBox1_Change()
 
    Dim baslik As Range, c As Integer, son As Integer
 
    If ComboBox1.Value = "" Then Exit Sub
 
    Sheets(ComboBox1.Text).Select
 
    With ListBox2
        .Clear
        .ColumnCount = 2
        .ColumnWidths = "10;0"
        .ListStyle = fmListStyleOption
        .MultiSelect = fmMultiSelectMulti
 
        son = Cells(1, Columns.Count).End(xlToLeft).Column
        For Each baslik In Range(Cells(1, 1), Cells(1, son))
            If baslik.Value <> "" Then
                .AddItem
                .Column(0, c) = baslik.Value
                .Column(1, c) = baslik.Column
                c = c + 1
            End If
        Next baslik
    End With
 
    ComboBox2.Value = ""
 
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ListBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 
    Dim sut As Integer, i As Long, hucre, x
 
    sut = ListBox2.List(ListBox2.ListIndex, 1)
 
    With CreateObject("Scripting.Dictionary")
        For i = 2 To Cells(Rows.Count, sut).End(xlUp).Row
            hucre = Cells(i, sut)
            If Not .exists(hucre) Then .Add hucre, Nothing
        Next i
        x = .keys
    End With
 
    With ComboBox2
        .Clear
        .List = x
    End With
 
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UserForm_Initialize()
 
    Dim syf As Integer
 
    Sheets("GELENIS").Select
 
    For syf = 1 To Worksheets.Count
        ComboBox1.AddItem Sheets(syf).Name
    Next syf
 
End Sub
.
 
Katılım
18 Şubat 2009
Mesajlar
11
Excel Vers. ve Dili
ekxcell 2007
Yanıt

Verdiğiniz bilgiler için teşekkür ederim.Allah razı olsun.Kolay gelsin.
 
Üst