• DİKKAT

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

İlişkili combobox ve listbox

vivident

vivident

Katılım
24 Kasım 2007
Mesajlar
769
Excel Vers. ve Dili
Office 365 - Türkçe
Arkadaşlar ekteki dosyada yapmak istediğim, kullanıcı veri girmek için comboboxları kullanırken aynı zamandada liste kısmındada süzme işlemini yapabilmesi.

makine - referans comboboxları birbirleri ile ilişkili çalışıyor ve sayfa1'e verileri yapıştırıyor
kodları şu şekilde ;
Kod: 
Dim con As Object

Private Sub ComboBox1_Change()
ComboBox2.Clear
ComboBox2.Column = con.Execute("select distinct REFERANS from [sayfa2$] where MAKINA ='" & ComboBox1.Text & "'").getrows
End Sub

Private Sub UserForm_Activate()
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
ComboBox1.Column = con.Execute("select distinct MAKINA from [Sayfa2$]").getrows
End Sub
Private Sub UserForm_Terminate()
Set con = Nothing
End Sub

Private Sub CommandButton1_Click()
    Cells(ActiveCell.Row, "D") = ComboBox1.Value
    Cells(ActiveCell.Row, "E") = ComboBox2.Value
    Cells(ActiveCell.Row, "F") = ComboBox3.Value
    Cells(ActiveCell.Row, "I") = ComboBox4.Value
    Unload Me
End Sub

Ben dosyam listbox ekledim
Önce boş dosyada çalıştırdım. kodlar şu şekilde ;
Kod: 
Private a As Long
Dim i As Long
Private Sub ComboBox1_Change()
For i = 2 To a
    If ComboBox1.Text = Cells(i, 4) Then
        With ListBox1
            .AddItem Cells(i, 4)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
        End With
    End If
Next i
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "50;50;350;50;50;50;50;50;50;50"
ListBox1.RowSource = "sayfa1!D3:L7"
a = Range("D65536").End(3).Row
        For i = 3 To Range("D65536").End(3).Row
        If WorksheetFunction.CountIf(Range("D3:D" & i), Cells(i, "D")) = 1 Then
            ComboBox1.AddItem Cells(i, "D")
        End If
    Next i
End Sub

İki kodda ayrı ayrı çalışıyor, fakat iki kodu tek sayfada toplarsam şu şekilde problem yaşıyorum ;
Kod: 
Private a As Long
Dim i As Long
Dim con As Object
Private Sub ComboBox1_Change()
ComboBox2.Clear
ComboBox2.Column = con.Execute("select distinct REFERANS from [sayfa2$] where MAKINA ='" & ComboBox1.Text & "'").getrows
For i = 2 To a
    If ComboBox1.Text = Cells(i, 4) Then
        With ListBox1
            .AddItem Cells(i, 4)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
        End With
    End If
Next i
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 8
ListBox1.RowSource = "sayfa1!D3:L7"
a = Range("D65536").End(3).Row
        For i = 3 To Range("D65536").End(3).Row
        If WorksheetFunction.CountIf(Range("D3:D" & i), Cells(i, "D")) = 1 Then
            ComboBox1.AddItem Cells(i, "D")
        End If
    Next i
End Sub
Private Sub CommandButton1_Click()
    Cells(ActiveCell.Row, "D") = ComboBox1.Value
    Cells(ActiveCell.Row, "E") = ComboBox2.Value
    Cells(ActiveCell.Row, "F") = ComboBox3.Value
    Cells(ActiveCell.Row, "I") = ComboBox4.Value
    Unload Me
End Sub
Private Sub UserForm_Activate()
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
ComboBox1.Column = con.Execute("select distinct MAKINA from [Sayfa2$]").getrows
End Sub
Private Sub UserForm_Terminate()
Set con = Nothing
End Sub

Dosyam ektedir. yardımlarınızı rica ediyorum
 

Ekli dosyalar

  • mg.xlsm
    mg.xlsm
    25.9 KB · Görüntüleme: 24
Kod: 
Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 8
[COLOR="DarkOrange"]'ListBox1.RowSource = "sayfa1!D3:L7"[/COLOR]

yukarıdaki kırmızı satırı silmeniz

Kod: 
Private Sub ComboBox1_Change()
ComboBox2.Clear
[COLOR="darkorange"]ListBox1.Clear[/COLOR]

Yukarıdaki kırmızı satırı eklemeniz gerekiyor
 
Hocam verdiğiniz kodları deneme fırsatım oldu. çalışıyor elinize sağlık. son üçgündür neredeyse açtığım her konuya cevap vermeye çalıştınız. bu yüzden size minnettarım

Combobox2'ye de uygulayamaya çalıştım. Oldu fakat listbox'ın ilk hücresi ile ikinci hücresi aynı değeri gösterdi. ekte öncesi, sonrası resmi ekleyorum
kodlarda şu şekilde ;

Kod: 
Private Sub ComboBox1_Change()
ComboBox2.Clear
ListBox1.Clear
ComboBox2.Column = con.Execute("select distinct REFERANS from [sayfa2$] where MAKINA ='" & ComboBox1.Text & "'").getrows
For i = 2 To a
    If ComboBox1.Text = Cells(i, 4) Then
        With ListBox1
            .AddItem Cells(i, 4)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
        End With
    End If
Next i
End Sub

Private Sub ComboBox2_Change()
ListBox1.Clear
For i = 2 To a
    If ComboBox2.Text = Cells(i, 5) Then
        With ListBox1
            .AddItem Cells(i, 5)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
        End With
    End If
Next i
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 8
a = Range("D65536").End(3).Row
        For i = 3 To Range("D65536").End(3).Row
        If WorksheetFunction.CountIf(Range("D3:D" & i), Cells(i, "D")) = 1 Then
            ComboBox1.AddItem Cells(i, "D")
        End If
    Next i
End Sub
 

Ekli dosyalar

  • önce.jpg
    önce.jpg
    95.2 KB · Görüntüleme: 19
  • sonra.jpg
    sonra.jpg
    94.8 KB · Görüntüleme: 8
Kod: 
.AddItem Cells(i, [COLOR="Red"]5[/COLOR])
Satırını
Kod: 
.AddItem Cells(i, [COLOR="red"]4[/COLOR])
Yapın Aşağıdaki gibi
Kod: 
Private Sub ComboBox2_Change()
ListBox1.Clear
For i = 2 To a
    If ComboBox2.Text = Cells(i, 5) Then
        With ListBox1
            .AddItem Cells(i, 4)
 
Hocam bu dosyanın satırına fazla veri gireleceği için bu filitreleme işi oldukça zorlayacak dedim. birkerede yapılması için Kodları butona bağladım. comboboxların altından kaldırdım. comboboxları seçiyorum veriler listboxa gelmiyor (problem yok) butona tıkladığımda hata alıyorum

Kodlar şu şekilde ;
Kod: 
Private Sub CommandButton2_Click()
ListBox1.Clear
For i = 2 To a
    If ComboBox1.Text = Cells(i, 4) Then
        With ListBox1
            .AddItem Cells(i, 4)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
    If ComboBox2.Text = Cells(i, 5) Then
        With ListBox1
            .AddItem Cells(i, 4)
            .List(.ListCount - 1, 1) = Cells(i, 5)
            .List(.ListCount - 1, 2) = Cells(i, 6)
            .List(.ListCount - 1, 3) = Cells(i, 7)
            .List(.ListCount - 1, 4) = Cells(i, 8)
            .List(.ListCount - 1, 5) = Cells(i, 9)
            .List(.ListCount - 1, 6) = Cells(i, 10)
            .List(.ListCount - 1, 7) = Cells(i, 11)
        End With
    End If
Next i
End Sub

Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 5
a = Range("D65536").End(3).Row
        For i = 3 To Range("D65536").End(3).Row
        If WorksheetFunction.CountIf(Range("D3:D" & i), Cells(i, "D")) = 1 Then
            ComboBox1.AddItem Cells(i, "D")
        End If
    Next i
End Sub
 
birinci İf yapısının bitişi yok
yani End If yok
ve yine birinci With yapısının bitişi yok
yani End With

Kod: 
       .List(.ListCount - 1, 7) = Cells(i, 11)
[COLOR="Red"]           End With
         End If[/COLOR]
    If ComboBox2.Text = Cells(i, 5) Then
        With ListBox1
kırmızı satırları eklemeleisin
 
dalgalikur' Alıntı:
birinci İf yapısının bitişi yok
yani End If yok
ve yine birinci With yapısının bitişi yok
yani End With

Kod: 
       .List(.ListCount - 1, 7) = Cells(i, 11)
[COLOR="Red"]           End With
         End If[/COLOR]
    If ComboBox2.Text = Cells(i, 5) Then
        With ListBox1
kırmızı satırları eklemeleisin
Genişletmek için tıkla ...

Şimdi farkettim, kopyalarken hata yaptım sanırım. Kodu yeniledim, fakat başka problemler var. örneğin comboboxlardan seçtik (süzme işlemini yaptığımız combobox1-2) command butonu tıklıyorum. Değişik verileri süzüyor. arada boş satırlar çıkıyor.

Bir yerde yine bi uyuşmazlık vara ama bulamadım. Dosyayı ekliyorum
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst