• DİKKAT

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

Combobox ile listboxta filitreleme

Hakan ERDOST

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Forumdan aldığım bir dosya üzeriden çalışırken filitrelemede hat veriyor.Şyleki Userform üzerindeki combolardan 1. sadece içeleri elırken 2.combo veriyi 1 e göre süzmüyor.dolayısıile 3. te hata veriyor.çalışma ekte.
 

Ekli dosyalar

Selamlar,

Formunuza ait kodları silip aşağıdkai kodları denermisiniz.

Kod: 
Option Explicit
 
Private Sub ComboBox1_Change()
    Dim DİZİB As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 Then
        DİZİB.Add HÜCRE.Offset(0, 1).Value, CStr(HÜCRE.Offset(0, 1).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox2.Clear
    
    For Each VERİ In DİZİB
        ComboBox2.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox2_Change()
    Dim DİZİC As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 Then
        DİZİC.Add HÜCRE.Offset(0, -7).Value, CStr(HÜCRE.Offset(0, -7).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox3.Clear
    
    For Each VERİ In DİZİC
        ComboBox3.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox3_Change()
    Dim DİZİD As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 And CStr(HÜCRE.Offset(0, -7).Value) = ComboBox3 Then
        DİZİD.Add HÜCRE.Offset(0, -4).Value, CStr(HÜCRE.Offset(0, -4).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox4.Clear
    
    For Each VERİ In DİZİD
        ComboBox4.AddItem VERİ
    Next
End Sub
 
Private Sub UserForm_Initialize()
    Dim DİZİA As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        DİZİA.Add HÜCRE.Value, CStr(HÜCRE.Value)
    Next
    
    On Error GoTo 0
    
    For Each VERİ In DİZİA
        ComboBox1.AddItem VERİ
    Next
End Sub
 
Korhan Ayhan' Alıntı:
Selamlar,

Formunuza ait kodları silip aşağıdkai kodları denermisiniz.

Kod: 
Option Explicit
 
Private Sub ComboBox1_Change()
    Dim DİZİB As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 Then
        DİZİB.Add HÜCRE.Offset(0, 1).Value, CStr(HÜCRE.Offset(0, 1).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox2.Clear
    
    For Each VERİ In DİZİB
        ComboBox2.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox2_Change()
    Dim DİZİC As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 Then
        DİZİC.Add HÜCRE.Offset(0, -7).Value, CStr(HÜCRE.Offset(0, -7).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox3.Clear
    
    For Each VERİ In DİZİC
        ComboBox3.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox3_Change()
    Dim DİZİD As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 And CStr(HÜCRE.Offset(0, -7).Value) = ComboBox3 Then
        DİZİD.Add HÜCRE.Offset(0, -4).Value, CStr(HÜCRE.Offset(0, -4).Value)
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox4.Clear
    
    For Each VERİ In DİZİD
        ComboBox4.AddItem VERİ
    Next
End Sub
 
Private Sub UserForm_Initialize()
    Dim DİZİA As New Collection, HÜCRE As Range, VERİ As Variant
    
    On Error Resume Next
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        DİZİA.Add HÜCRE.Value, CStr(HÜCRE.Value)
    Next
    
    On Error GoTo 0
    
    For Each VERİ In DİZİA
        ComboBox1.AddItem VERİ
    Next
End Sub
Genişletmek için tıkla ...

İlginize teşekkürler.Veriler Combolara geliyor.Ancak Listbox ta görüntülenmiyor.
 
Selamlar,

Aşağıdaki kodları deneyin.

Kod: 
Option Explicit
 
Private Sub ComboBox1_Change()
    Dim DİZİB As New Collection, HÜCRE As Range, VERİ As Variant, SATIR As Long
    
    On Error Resume Next
    
    ListBox1.ColumnCount = 6
    ListBox1.ColumnWidths = "50,130,50,50,75,75"
    ListBox1.RowSource = ""
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 Then
        DİZİB.Add HÜCRE.Offset(0, 1).Value, CStr(HÜCRE.Offset(0, 1).Value)
        With ListBox1
            .AddItem
            .List(SATIR, 0) = Cells(HÜCRE.Row, "A")
            .List(SATIR, 1) = Cells(HÜCRE.Row, "B")
            .List(SATIR, 2) = Cells(HÜCRE.Row, "C")
            .List(SATIR, 3) = Cells(HÜCRE.Row, "D")
            .List(SATIR, 4) = Cells(HÜCRE.Row, "E")
            .List(SATIR, 5) = Cells(HÜCRE.Row, "F")
             SATIR = SATIR + 1
        End With
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox2.Clear
    
    For Each VERİ In DİZİB
        ComboBox2.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox2_Change()
    Dim DİZİC As New Collection, HÜCRE As Range, VERİ As Variant, SATIR As Long
    
    On Error Resume Next
    
    ListBox1.ColumnCount = 6
    ListBox1.ColumnWidths = "50,130,50,50,75,75"
    ListBox1.Clear
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 Then
        DİZİC.Add HÜCRE.Offset(0, -7).Value, CStr(HÜCRE.Offset(0, -7).Value)
        With ListBox1
            .AddItem
            .List(SATIR, 0) = Cells(HÜCRE.Row, "A")
            .List(SATIR, 1) = Cells(HÜCRE.Row, "B")
            .List(SATIR, 2) = Cells(HÜCRE.Row, "C")
            .List(SATIR, 3) = Cells(HÜCRE.Row, "D")
            .List(SATIR, 4) = Cells(HÜCRE.Row, "E")
            .List(SATIR, 5) = Cells(HÜCRE.Row, "F")
             SATIR = SATIR + 1
        End With
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox3.Clear
    
    For Each VERİ In DİZİC
        ComboBox3.AddItem VERİ
    Next
End Sub
 
Private Sub ComboBox3_Change()
    Dim DİZİD As New Collection, HÜCRE As Range, VERİ As Variant, SATIR As Long
    
    On Error Resume Next
    
    ListBox1.ColumnCount = 6
    ListBox1.ColumnWidths = "50,130,50,50,75,75"
    ListBox1.Clear
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        If HÜCRE.Value = ComboBox1 And CStr(HÜCRE.Offset(0, 1).Value) = ComboBox2 And CStr(HÜCRE.Offset(0, -7).Value) = ComboBox3 Then
        DİZİD.Add HÜCRE.Offset(0, -4).Value, CStr(HÜCRE.Offset(0, -4).Value)
        With ListBox1
            .AddItem
            .List(SATIR, 0) = Cells(HÜCRE.Row, "A")
            .List(SATIR, 1) = Cells(HÜCRE.Row, "B")
            .List(SATIR, 2) = Cells(HÜCRE.Row, "C")
            .List(SATIR, 3) = Cells(HÜCRE.Row, "D")
            .List(SATIR, 4) = Cells(HÜCRE.Row, "E")
            .List(SATIR, 5) = Cells(HÜCRE.Row, "F")
             SATIR = SATIR + 1
        End With
        End If
    Next
    
    On Error GoTo 0
    
    ComboBox4.Clear
    
    For Each VERİ In DİZİD
        ComboBox4.AddItem VERİ
    Next
End Sub
 
Private Sub UserForm_Initialize()
    Dim DİZİA As New Collection, HÜCRE As Range, VERİ As Variant, SATIR As Long
    
    On Error Resume Next
    
    ListBox1.ColumnCount = 6
    ListBox1.ColumnWidths = "50,130,50,50,75,75"
    ListBox1.RowSource = "GELEN!A2:F" & [GELEN!A65536].End(3).Row
    
    For Each HÜCRE In Range("I2:I" & Range("I65536").End(3).Row)
        DİZİA.Add HÜCRE.Value, CStr(HÜCRE.Value)
    Next
    
    On Error GoTo 0
    
    For Each VERİ In DİZİA
        ComboBox1.AddItem VERİ
    Next
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst