Sayfada Arama Yapma

[alperalper]

Arkadaşlar aşağıdaki kodlara bi bakarsanız aynı sayfada arama yapıyorum userform üzerinden sonuçları listboxa listeliyorum ama bi sorun var. Aynı isimle birden fazla veri giriyorum ama sadece birini gösteriyor.. Bunu nasıl düzeltebilirim....

Private Sub CommandButton2_Click()
Dim Adı As String
    ListBox1.Clear
    ListBox1.ColumnCount = 6
    ListBox1.ColumnWidths = "30;72;66;88;88;0"
    If TextBox1 = "" Then
    MsgBox "ARAMA YAPABİLMEK İÇİN LÜTFEN  ( İSİM )  GİRİNİZ !", vbExclamation, "UYARI !"
    TextBox1 = ""
    TextBox1.SetFocus
    Exit Sub: End If
    Adı = TextBox1
    For X = 1 To Sheets.Count
    Set BUL = Sheets(X).Cells.Find(Adı)
    If Not BUL Is Nothing Then
    ADRES = BUL.Row
    ListBox1.AddItem
    ListBox1.List(SATIR, 0) = Sheets(X).Cells(ADRES, 1)
    ListBox1.List(SATIR, 1) = Sheets(X).Cells(ADRES, 2)
    ListBox1.List(SATIR, 2) = Sheets(X).Cells(ADRES, 3)
    ListBox1.List(SATIR, 3) = Sheets(X).Cells(ADRES, 4)
    ListBox1.List(SATIR, 4) = Sheets(X).Cells(ADRES, 5)
    SATIR = SATIR + 1
    End If
    Next
    If ListBox1.ListCount = 0 Then
    MsgBox "ARADIĞINIZ KAYIT BULUNAMAMIŞTIR !", vbExclamation, "ARAMA SONUCU"
    TextBox1 = ""
    TextBox1.SetFocus
    Else
    End If
    Label7.Caption = ListBox1.ListCount & " ADET KAYIT BULUNMUŞTUR."
End Sub

 

[Ferhat Pazarçevirdi]

Kodunuzu aşağıdaki gibi revize ediniz.

(Asıl dosya olmadığı için; hazırladığım bir örneği ekte bulabilirsiniz. Bu dosyada; "A" değerini aratınız)

Private Sub CommandButton1_Click()
Dim Adı As String
With ListBox1
    .Clear
    .ColumnCount = 6
    .ColumnWidths = "30;72;66;88;88;0"
End With
If TextBox1 = "" Then
    MsgBox "ARAMA YAPABİLMEK İÇİN LÜTFEN  ( İSİM )  GİRİNİZ !", vbExclamation, "UYARI !"
    TextBox1 = ""
    TextBox1.SetFocus
    Exit Sub:
End If
    
Adı = TextBox1
For X = 1 To Sheets.Count
    Set Bul = Sheets(X).Cells.Find(Adı)
    If Not Bul Is Nothing Then
            Adres = Bul.Address
         Do
            sat = Bul.Row
            ListBox1.AddItem
            ListBox1.List(SATIR, 0) = Sheets(X).Cells(sat, 1)
            ListBox1.List(SATIR, 1) = Sheets(X).Cells(sat, 2)
            ListBox1.List(SATIR, 2) = Sheets(X).Cells(sat, 3)
            ListBox1.List(SATIR, 3) = Sheets(X).Cells(sat, 4)
            ListBox1.List(SATIR, 4) = Sheets(X).Cells(sat, 5)
            SATIR = SATIR + 1
            Set Bul = Sheets(X).Cells.FindNext(Bul)
         Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
Next
    
    If ListBox1.ListCount = 0 Then
    MsgBox "ARADIĞINIZ KAYIT BULUNAMAMIŞTIR !", vbExclamation, "ARAMA SONUCU"
    TextBox1 = ""
    TextBox1.SetFocus
    Else
    End If
    Label7.Caption = ListBox1.ListCount & " ADET KAYIT BULUNMUŞTUR."
End Sub