listboxta Sutun Sınırlaması

[sahir73]

Bir çalışam için listboxta 10 dan fazla sutun kuallanmam gerekiyor. AddItem yöntemi 10 sutuna izin veriyor. Kodları RowSource uyarlama konusunda yardımınza ihtiyacım var.

Private Sub cmbFilitrele_Change()
    On Error Resume Next
    Dim i           As Range, x As String, ARABUL As String
    Application.ScreenUpdating = False
    Dim sh          As Worksheet
    Set sh = ThisWorkbook.Sheets("MUSTERILER")
    sh.Activate
    If UCase(cmbFilitrele.Value) = "" Then
        lstMusteriler.RowSource = "MUSTERILER!A2:M" & [MUSTERILER!A65536].End(3).Row
        Exit Sub
    End If
    x = "E"        ''''comboboxta değerin aaranıldığı sutun
    With Sheets("MUSTERILER")
        lstMusteriler.RowSource = Empty
        lstMusteriler.Clear
        lstMusteriler.RowSource = ""
        lstMusteriler.ColumnCount = 13
        If x <> "" Then
            ARABUL = .Range(x & 2 & ":" & x & .Range(x & "65536").End(3).Row).Address
            For Each i In .Range(ARABUL)
                If UCase(LCase(i.Value)) Like UCase(LCase(cmbFilitrele)) & "*" Then
                    With lstMusteriler
                        .AddItem Cells(i.Row, 1).Value
                        .List(.ListCount - 1, 1) = Cells(i.Row, 2).Value
                        .List(.ListCount - 1, 2) = Cells(i.Row, 3).Value
                        .List(.ListCount - 1, 3) = Cells(i.Row, 4).Value
                        .List(.ListCount - 1, 4) = Cells(i.Row, 5).Value
                        .List(.ListCount - 1, 5) = Cells(i.Row, 6).Value
                        .List(.ListCount - 1, 6) = Cells(i.Row, 7).Value
                        .List(.ListCount - 1, 7) = Cells(i.Row, 8).Value
                        .List(.ListCount - 1, 8) = Cells(i.Row, 9).Value
                        .List(.ListCount - 1, 9) = Cells(i.Row, 10).Value
                        .List(.ListCount - 1, 10) = Cells(i.Row, 11).Value
                        .List(.ListCount - 1, 11) = Cells(i.Row, 12).Value
                        .List(.ListCount - 1, 12) = Cells(i.Row, 13).Value
                    End With
                End If
            Next i
        End If
    End With
    ARABUL = vbNullString: x = vbNullString: Set i = Nothing
    Application.ScreenUpdating = True
    Set sh = Nothing
    Set sh = Worksheets("ANASAYFA")
    sh.Activate
    Set sh = Nothing
End Sub

 

[Korhan Ayhan]

Arama işleminde yardımcı bir sayfaya verileri yazdırırsanız sonrasında sayfadan Listbox nesnesine RowSource metoduyla verileri yükleyebilirsiniz.

Yok ben yardımcı sayfa ile uğraşamam derseniz forumda ListBox+Redim ifadesiyle arama yapınız. Bolca konu var.

 

[sahir73]

Arama işleminde yardımcı bir sayfaya verileri yazdırırsanız sonrasında sayfadan Listbox nesnesine RowSource metoduyla verileri yükleyebilirsiniz.

Yok ben yardımcı sayfa ile uğraşamam derseniz forumda ListBox+Redim ifadesiyle arama yapınız. Bolca konu var.

Çok teşekkür ederim Korhan bey çok yardımcı oldu.