Userform ListBox'ta arama yapma

[muratgunay48]

Arkadaşlar, sayın hocalarım, direkt sormuyorum inanın saatlerdir arıyorum. ADD için yapmaya çalıştığım bir dosya var. Tamamı bana ait değil. Hocalarımın yazdığı kodlar da var.
Arama kısmını yapamadım.
ListBox "data" adlı sayfadan alıyor

@Korhan Ayhan hocamın yazdığı bir kodu uyarlamaya çalıştım. Hata veriyor.
Yardımcı olabilir misiniz?
Teşekkür ederim.
Saygılarımla.
Şifresi 123

Private Sub TextBox21_Change()
    Dim S1 As Worksheet, WF As WorksheetFunction, Adres_Listesi As Object, Adres As String
    Dim Aranan_Metin As Variant, Metin_Say As Integer, Liste As Variant
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Say As Long
   
    Set S1 = Sheets("data")
    Set WF = WorksheetFunction
    Set Adres_Listesi = VBA.CreateObject("Scripting.Dictionary")
   
    Adres = ""
    Metin_Say = 0
    Say = 0
   
    Son = S1.Cells(S1.Rows.Count, 5).End(3).Row
   
    TextBox21.BackColor = &H80000005
    TextBox21.ForeColor = vbRed
   
    ListBox1.Clear
   
    If Len(TextBox21) > 0 Then
        Veri = S1.Range("C2:C" & Son).Value
        ReDim Liste(1 To 1, 1 To 1)
       
        Aranan_Metin = Split(WF.Trim(TextBox21), " ")
       
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            For Y = LBound(Aranan_Metin) To UBound(Aranan_Metin)
                If UCase(Replace(Replace(Veri(X, 1), "ı", "I"), "i", "İ")) Like _
                    "*" & UCase(Replace(Replace(Aranan_Metin(Y), "ı", "I"), "i", "İ")) & "*" Then
                    Metin_Say = Metin_Say + 1
                End If
            Next
                   
            If Metin_Say = UBound(Aranan_Metin) + 1 Then
                Adres = "A" & X + 1
                If Not Adres_Listesi.Exists(Adres) Then
                    Say = Say + 1
                    Adres_Listesi.Add Adres, Say
                    ReDim Preserve Liste(1 To 1, 1 To Say)
                    Liste(1, Say) = Veri(X, 1)
                End If
            End If
           
            Metin_Say = 0
        Next
       
        If Say > 0 Then
            ListBox1.Column = Liste
        Else
            TextBox21.BackColor = vbRed
            TextBox21.ForeColor = vbWhite
        End If
       
        Say = 0
        Adres = ""
        Adres_Listesi.RemoveAll
    End If

    Set S1 = Nothing
    Set WF = Nothing
    Set Adres_Listesi = Nothing
End Sub

 

[muhasebeciyiz]

Elinizdeki VBA kodu, bir UserForm'daki TextBox21'e girilen metne göre "data" sayfasının C sütunundaki verileri filtreleyip ListBox1'e listelemeye çalışıyor

Private Sub TextBox21_Change()
    Dim S1 As Worksheet, WF As WorksheetFunction, Adres_Listesi As Object, Adres As String
    Dim Aranan_Metin As Variant, Metin_Say As Integer, Liste As Variant
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Say As Long
 
    Set S1 = Sheets("data")
    Set WF = WorksheetFunction
    Set Adres_Listesi = VBA.CreateObject("Scripting.Dictionary")
 
    Adres = ""
    Metin_Say = 0
    Say = 0
 
    Son = S1.Cells(S1.Rows.Count, 5).End(3).Row
 
    TextBox21.BackColor = &H80000005
    TextBox21.ForeColor = vbRed

    ListBox1.Clear
 
    If Len(TextBox21) > 0 Then
        Veri = S1.Range("C2:C" & Son).Value
     
        Aranan_Metin = Split(WF.Trim(TextBox21), " ")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
         
            If Metin_Say = UBound(Aranan_Metin) + 1 Then
                Adres = "A" & X + 1
                If Not Adres_Listesi.Exists(Adres) Then
                    Say = Say + 1
                    Adres_Listesi.Add Adres, Say
                 
                    If Say = 1 Then
                        ReDim Liste(1 To 1, 1 To 1)
                    Else
                        ReDim Preserve Liste(1 To Say, 1 To 1)
                    End If
                 
                    Liste(Say, 1) = Veri(X, 1)
                End If
            End If
         
            Metin_Say = 0
        Next
     
        If Say > 0 Then
            ListBox1.List = Liste
         
        Else

    Set S1 = Nothing
    Set WF = Nothing
    Set Adres_Listesi = Nothing
End Sub

ListBox1.ColumnCount: UserForm tasarım ekranında veya kodla bu özelliğin 1 olduğundan emin olun.
RowSource: UserForm tasarımında ListBox1'in RowSource özelliğinin boş olduğundan emin olun. Koddaki ListBox1.List = Liste satırı, RowSource ayarlıysa çalışmayabilir.

Yukarıdaki değişiklikleri uyguladıktan sonra kodunuz hala hata veriyor mu, yoksa listenizde hiç veri görünmüyor mu? Eğer hala hata varsa, hangi satırda ve ne tür bir hata aldığınızı paylaşır mısınız?

 

[muratgunay48]

Elinizdeki VBA kodu, bir UserForm'daki TextBox21'e girilen metne göre "data" sayfasının C sütunundaki verileri filtreleyip ListBox1'e listelemeye çalışıyor

Private Sub TextBox21_Change()
    Dim S1 As Worksheet, WF As WorksheetFunction, Adres_Listesi As Object, Adres As String
    Dim Aranan_Metin As Variant, Metin_Say As Integer, Liste As Variant
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Say As Long

    Set S1 = Sheets("data")
    Set WF = WorksheetFunction
    Set Adres_Listesi = VBA.CreateObject("Scripting.Dictionary")

    Adres = ""
    Metin_Say = 0
    Say = 0

    Son = S1.Cells(S1.Rows.Count, 5).End(3).Row

    TextBox21.BackColor = &H80000005
    TextBox21.ForeColor = vbRed

    ListBox1.Clear

    If Len(TextBox21) > 0 Then
        Veri = S1.Range("C2:C" & Son).Value
    
        Aranan_Metin = Split(WF.Trim(TextBox21), " ")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
        
            If Metin_Say = UBound(Aranan_Metin) + 1 Then
                Adres = "A" & X + 1
                If Not Adres_Listesi.Exists(Adres) Then
                    Say = Say + 1
                    Adres_Listesi.Add Adres, Say
                
                    If Say = 1 Then
                        ReDim Liste(1 To 1, 1 To 1)
                    Else
                        ReDim Preserve Liste(1 To Say, 1 To 1)
                    End If
                
                    Liste(Say, 1) = Veri(X, 1)
                End If
            End If
        
            Metin_Say = 0
        Next
    
        If Say > 0 Then
            ListBox1.List = Liste
        
        Else

    Set S1 = Nothing
    Set WF = Nothing
    Set Adres_Listesi = Nothing
End Sub

ListBox1.ColumnCount: UserForm tasarım ekranında veya kodla bu özelliğin 1 olduğundan emin olun.
RowSource: UserForm tasarımında ListBox1'in RowSource özelliğinin boş olduğundan emin olun. Koddaki ListBox1.List = Liste satırı, RowSource ayarlıysa çalışmayabilir.

Yukarıdaki değişiklikleri uyguladıktan sonra kodunuz hala hata veriyor mu, yoksa listenizde hiç veri görünmüyor mu? Eğer hala hata varsa, hangi satırda ve ne tür bir hata aldığınızı paylaşır mısınız?

Hocam yazdığınız kodu yapıştırdım ama olmadı. Nerede hata yapıyorum bir türlü bulamadım.