ListBox'ta süzme işlemi...

[Ridan]

Aşağıdaki kodun TextBox1_Change olayında TextBox1'e veri girdiğimde personelin adına göre alfabetik listeleniyor. Ancak, 11 sütundan fazlası hata veriyor.

İkincisi; Ada göre suzme yaptığımda, Listbox'a B sütunundan itibaren değil de A-N sütunu arası listelenmesini istiyorum. "ListBox1.Column(j - 2, x) = .Cells(k.Row, j).Value" satırında hata alıyorum.

---------------
Private Sub TextBox1_Change()
Dim k As Range, j As Byte, adr As String, x As Long
ListBox1.RowSource = vbNullString
With Sheets("Sayfa1")
Set k = .Range("B:B").Find(TextBox1.Text & "*", , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
ListBox1.AddItem
For j = 2 To 14
ListBox1.Column(j - 2, x) = .Cells(k.Row, j).Value
Next j
x = x + 1
Set k = Range("B:B").FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
End If
End With
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
TextBox2.Text = ListBox1.Column(0)
TextBox3.Text = ListBox1.Column(1)
TextBox4.Text = ListBox1.Column(2)
TextBox5.Text = ListBox1.Column(3)
TextBox6.Text = ListBox1.Column(4)
TextBox7.Text = ListBox1.Column(5)
TextBox8.Text = ListBox1.Column(6)
TextBox9.Text = ListBox1.Column(7)
TextBox10.Text = ListBox1.Column(8)
TextBox11.Text = ListBox1.Column(9)
TextBox12.Text = ListBox1.Column(10)
TextBox13.Text = ListBox1.Column(11)
TextBox14.Text = ListBox1.Column(12)
TextBox15.Text = ListBox1.Column(13)
End Sub


Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 14
ListBox1.RowSource = "Sayfa1!A2:N" & Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
End Sub

 

[ynmcan]

Syn. Rıdyan ;
Kodta kırmızı ile belirtiğim kısımları değiştirdim.
Dosyanız ekte.

Private Sub TextBox1_Change()
Dim k As Range, j As Byte, adr As String, x As Long
ListBox1.RowSource = vbNullString
With Sheets("Sayfa1")
    Set k = .Range("B:B").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            ListBox1.AddItem
            For j = [COLOR="Red"]1[/COLOR] To 14
           [COLOR="Red"] On Error Resume Next[/COLOR]
                ListBox1.Column(j - [COLOR="Red"]1[/COLOR], x) = .Cells(k.Row, j).Value
            Next j
            x = x + 1
            Set k = Range("B:B").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
End With
End Sub

 

[Ridan]

Run-time error...

Listeleme A sütunundan başladı ama;
Süzme işlemi yaptıktan sonra listbox'ta listelenen personele tıkladığımda Run-time error hatası alıyorum. A-N sütunu arası listelenmiyor. Zannedersem forumu gezerken görmüştüm. AddItem ile 10 sütundan fazlası listboxa alınmıyormuş. Öyleyse kodda nasıl bir değişiklik yapmam gerekli...

Hata satırı; TextBox12.Text = ListBox1.Column(10)

 

[ynmcan]

Syn. Rıdan;
Listbox1 clik olayındaki kodları aşağıdaki şekilde değiştirdim.
Bu kod ile Textboxlar veriyi sayfadan almakta.
Dosyanız Ekte.

Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
TextBox2.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 1)
TextBox3.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 2)
TextBox4.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 3)
TextBox5.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 4)
TextBox6.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 5)
TextBox7.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 6)
TextBox8.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 7)
TextBox9.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 8)
TextBox10.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 9)
TextBox11.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 10)
TextBox12.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 11)
TextBox13.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 12)
TextBox14.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 13)
TextBox15.Text = Sheets("Sayfa1").Cells(ListBox1.ListIndex + 2, 14)

End Sub

 

[Ridan]

Sn. ynmcany,

Süzme işleminden sonra listboxtan seçim yaptığımda textbox'lara seçilen kişiye ait bilgiler yerine başka kişi gelmektedir. Ayrıca süzme işlemi yaptıktan sonra textbox1 temizlendiğinde birinci sıradaki kişi (Cahit ÇETİNÖZ) listboxta en sona gitmektedir.

 

[ynmcan]

Syn. Rıdan;
Kodu aşağıdaki şekilde değiştirdim.
Ancak textbox1 i silince ilk sıradaki verinin en alta gelmesini bende çözemedim.
Dosyanız ekte.

Private Sub ListBox1_Click()

Dim Aranan_Veri As Variant, Say As Long
    Dim Bul As Range, Adres As String
 
    Aranan_Veri = ListBox1.List(ListBox1.ListIndex, 1)
Set Bul = Cells.Find(Aranan_Veri, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Adres = Bul.Address
    Do
    With Sheets("Sayfa1")
    
    
 For i = 1 To 14
    Controls("textbox" & i + 1) = .Range(Bul.Address).Offset(0, i - 2)
    Next i
    Say = Say + 1
    

 End With
 Set Bul = Cells.FindNext(Bul)
    On Error Resume Next
    Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
End Sub

 

[ynmcan]

Syn. Rıdan;
Textbox1 i silince ilk sıradaki verinin en alta gelmesini ile ilgili sorunu;
Textbox1 in change olayındaki koda kırmızı ile belirtiğim satırları ekleyerek çözmeye çalıştım.
Dosyanız ekte.

Private Sub TextBox1_Change()
[COLOR="Red"]If TextBox1.Text = "" Then
ListBox1.ColumnCount = 14
ListBox1.RowSource = "Sayfa1!A2:N" & Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
Else[/COLOR]

Dim k As Range, j As Byte, adr As String, x As Long
ListBox1.RowSource = vbNullString
With Sheets("Sayfa1")
    Set k = .Range("B2:B65536").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            ListBox1.AddItem
            For j = 1 To 14
            On Error Resume Next
                ListBox1.Column(j - 1, x) = .Cells(k.Row, j).Value
            Next j
            x = x + 1
            Set k = Range("B2:B65536").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
End With
End If

 

[Ridan]

Teşekkürler ynmcany..
Bu şekilde tamamdır. Emeğine sağlık.

 

[Ridan]

Sizden bir ricam daha olacak ama...

Personel sayfada görüldüğü kadar değil..Haliyle artacak..Binleri bulabilir.. Bu yüzden süzülen isimler ALFABETİK olarak listelenebilir mi?

 

[ynmcan]

Syn. Rıdan;
Aşağıdaki kodu kullanabilirsiniz.
Ben bu kodu şimdilik userformun üzerine bir adet buton ekleyerek onun click olayına ekledim.
Siz bunu asıl dosyanızdaki varsa kaydet, sil ve değiştir butonların daki kodların en altına ekleyin.
dosyanız ekte.

Sheets("Sayfa1").Range("B2:N65536").Sort Key1:= _
Sheets("Sayfa1").Range("B2"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

 

[Ridan]

Teşekkürler ynmcany.

 

[orkuncan5]

userformda isimlerden birine tıkladıktan sonra sıralaya tıkladığımda hata veriyor

 

[ynmcan]

Syn. Orkuncan5

Dosyayı düzelttim.

Ancak bu sıralama makrosunu burada kullanmanın bir mantığı yok.

On nolu mesajdada belirtiğim gibi " Ben bu kodu şimdilik userformun üzerine bir adet buton ekleyerek onun click olayına ekledim.
Siz bunu asıl dosyanızdaki varsa kaydet, sil ve değiştir butonların daki kodların en altına ekleyin. "

Dosya ekte.