Userform ListBox'ta arama yapma

muratgunay48 · Bugün 11:07

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

Kod:

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 · Bugün 12:08

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

Kod:

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 · Bugün 12:16

muhasebeciyiz' Alıntı:
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

Kod:

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.

Userform ListBox'ta arama yapma

muratgunay48

Ekli dosyalar

muhasebeciyiz

muratgunay48