ComboBoxa Göre ListBoxa Aktarım

[mhrcvk]

Merhabalar,

Ekte Mantığı Basit ama vba'da acemi olanlar için oldukça zor bir durum söz konusu,

Ben sadece başlangıcını yapabildim ve ComboBox'a benzersiz değer getirdim.

Taleplerim,
1- Mümkün mü bilmiyorum combobox'da birden fazla seçim yapabilmek istiyorum.
2- Comboboxda seçilen ana kategorilere göre aşağıdaki listbox1de alt kategorileri listelemek istiyorum.
3- Listbox1'den çift tıklayarak veya seçtiklerimi bir butona bağlayarak list box 2ye aktarmak istiyorum.
4-Listbox2 de ki kategorileri Dışa aktar butonu yardımı ile yeni bir excel sayfasına aktarmak istiyorum.

Mümkünse yardımcı olursanız sevinirim.

 

[Muzaffer Ali]

Merhaba.

Formdaki kodları silin aşağıdaki kodları kopyalayın.

Listelerin ikisine de çift tıklayarak listeler arasında aktarım yapabilirsiniz.

Option Explicit

Private Sub ComboBox1_Change()
    Dim SatirSay As Long
    Dim Bak As Long
    ListBox1.Clear
    With ThisWorkbook.Worksheets("Sayfa1")
        SatirSay = .Cells(Rows.Count, "A").End(3).Row
        For Bak = 4 To SatirSay
            If .Cells(Bak, "A").Value = ComboBox1.Text Then
                ListBox1.AddItem .Cells(Bak, "B").Value
            End If
        Next
    End With
End Sub

Private Sub CommandButton1_Click()
    Dim YeniDosya As Workbook
    Dim Bak As Long
    Dim AktarBak As Long
    Dim SatirSay As Long
    Set YeniDosya = Workbooks.Add
    For Bak = 0 To ListBox2.ListCount - 1
        With ThisWorkbook.Worksheets("Sayfa1")
            SatirSay = .Cells(Rows.Count, "A").End(3).Row
            For AktarBak = 4 To SatirSay
                If .Cells(AktarBak, "A").Value = ListBox2.List(Bak, 1) And .Cells(AktarBak, "B").Value = ListBox2.List(Bak, 0) Then
                    .Rows(AktarBak).Copy YeniDosya.Worksheets(1).Rows(Bak + 1)
                    Exit For
                End If
            Next
        End With
    Next
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox1.ListCount < 1 Then Exit Sub
    ListBox2.AddItem ListBox1.Value
    ListBox2.List(ListBox2.ListCount - 1, 1) = ComboBox1.Text
    ListBox1.RemoveItem (ListBox1.ListIndex)
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    If ListBox2.ListCount < 1 Then Exit Sub
    ListBox1.AddItem ListBox2.Value
    ListBox2.RemoveItem (ListBox2.ListIndex)
End Sub

Private Sub UserForm_Click()
MsgBox ListBox1.ColumnWidths
End Sub

Private Sub UserForm_Initialize()
    Dim x As Long
    With ThisWorkbook.Worksheets("Sayfa1")
        For x = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            If WorksheetFunction.CountIf(.Range("a4:a" & x), .Cells(x, 1)) = 1 Then
                ComboBox1.AddItem .Cells(x, 1).Value
            End If
        Next
    End With
End Sub

 

[mhrcvk]

Hocam ilgin için çok teşekkür ederim fakat eksiklerimiz var düzeltmeye çalıştım ama beceremedim

Eksiklikler,

1- Combobox'dan 1den fazla seçim yapabilmek istiyorum.
2-listbox1deki değerlerin yinelenmemesini istiyorum.
3-ComanadButton ile yapılan aktarımda başlığında gelmesini istiyorum.ilk satır başlık olacak.

Yardımcı olabilirseniz sevinirim.