listbox veri

[kan-nas]

Private Sub CommandButton1_Click()
For i = 2 To Range("a65536").End(3).Row
If Cells(i, 1).Value = ComboBox1.Value Then
ListBox1.AddItem Cells(i, 1)
End If
Next i
End Sub

İsteğim listedeki isimle comboboxtaki isim aynı ise o kişiye ait bilgilerin Listbox1'e aktarılması. Sadece comboboxta seçtiğim kişi sıralansın.
Yukarıdaki kod olmadı.

Yardımlarınız için.

 

[asi_kral]

Merhaba
Dosya ekler misiniz_? İçerisine açıklama eklerseniz yardımcı olurum sanırım

 

[kan-nas]

dosya ektedir.

 

[kan-nas]

Arkadaşlar konu günceldir.

 

[asi_kral]

dosya ektedir.

Userform'un kod bölümüne

Option Explicit
Private Sub CommandButton1_Click()
'Konu       :   Combobox Seçimine Göre Listbox'a Veri
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As Long
ListBox1.ColumnCount = 2
ListBox1.Clear
kral = 0
For asi = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(asi, "A") = ComboBox1 Then
ListBox1.AddItem
ListBox1.List(kral, 0) = Cells(asi, "A")
ListBox1.List(kral, 1) = Cells(asi, "B")
kral = kral + 1
End If: Next
MsgBox ComboBox1 & " Verilerini Listeledim" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Private Sub UserForm_Initialize()
'Konu       :   Combobox ve Listbox'a Veri
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim asi As Long
ListBox1.ColumnCount = 2
For asi = 2 To Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.AddItem
ListBox1.List(asi - 2, 0) = Cells(asi, "A")
ListBox1.List(asi - 2, 1) = Cells(asi, "B")
If WorksheetFunction.CountIf(Range("A2:A" & asi), Cells(asi, "A")) = 1 Then
ComboBox1.AddItem Cells(asi, "A")
End If: Next
End Sub

Bu kodu kopyalayın ve deneyin.

 

[Orion1]

Dosyanız ektedir.
Not:ile başlar şeklinde arama yapılıyor.

Private Sub CommandButton1_Click()
Dim k As Range, sat As Long, myarr(), adr As String, i As Long
ListBox1.RowSource = ""
With Sheets("Sheet1")
    sat = .Cells(Rows.Count, "A").End(xlUp).Row
    If sat < 2 Then Exit Sub
    ReDim myarr(1 To 2, 1 To sat)
    Set k = .Range("A2:A" & sat).Find(ComboBox1.Value & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            i = i + 1
            myarr(1, i) = k.Value
            myarr(2, i) = k.Offset(0, 1).Value
            Set k = .Range("A2:A" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
        ReDim Preserve myarr(1 To 2, 1 To i)
        ListBox1.Column = myarr
        Erase myarr
    End If
    Set k = Nothing
End With

End Sub