Listbox içerisinde arama

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Merhabalar ustalar;

inanın bu basit bir işlem için 2 gündür uğraşıyorum içinden çıkamadım uğraşayım öğreneyim istiyorum ama kafa almıyor demekki araştırıyorum ekliyorum ama çalışmıyor yapamıyorum resimde görünen yerde arama veya listbox üzerinde 2 3 harf ile arama yapsın istiyorum ama olmuyo yardım edebilirmisiniz ?aaa.png
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Linklerden faydalanabilirsiniz.

 

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Yazım Hatası Yapmışım kusura bakmayın bu basit işlem derken bilen ustalara karşı kullandığım bi kelimeydi kusura bakmayın emeğin basiti olmaz kusura bakmayın tekrar.
 

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Linklerden faydalanabilirsiniz.

ustam teşekkür ederim ama bu konuları hep gezdim uyarlamaya çalıştım ama içeriğe ekleyemedim içeren kelimeler şeklinde direk lixtboxda arama yapacak ama oraya uyarlayamadım bunu konulara baktım hepsine
 

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Merhaba;

Acaba Konuya bakabilen oldumu halen uğraşıyorum ama halen yapamamış durumdayım
 

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Merhaba Konu halen çözülememiştir yardım edebilecek varmı lütfen
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Arama işlemini düzenledim deneyiniz.

C++:
Sub KayitlariAl()
    Dim S1 As Worksheet, WF As WorksheetFunction, Adres_Listesi As Object
    Dim Adres As String, Aranan_Metin As Variant, Metin_Say As Integer
    Dim Liste As Variant, Son As Long, Veri As Variant, X As Long, Y As Long, Say As Long
    
    Set WF = WorksheetFunction
    Set Adres_Listesi = VBA.CreateObject("Scripting.Dictionary")
    
    Adres = ""
    Metin_Say = 0
    Say = 0
    
    Arama.BackColor = &H80000005
    Arama.ForeColor = vbRed
    
    If Me.OptionButton1.Value = True Then
        Set S1 = Sheets("Parça Listesi")
    ElseIf Me.OptionButton2.Value = True Then
        Set S1 = Sheets("Parça Listesi EUR")
    ElseIf Me.OptionButton3.Value = True Then
        Set S1 = Sheets("İşçilik")
    End If
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    If Len(Arama) > 0 Then
        ListBox1.Clear
        
        Veri = S1.Range("A2:A" & Son).Value
        ReDim Liste(1 To 1, 1 To 1)
        
        Aranan_Metin = Split(WF.Trim(Arama), " ")
        
        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
            Arama.BackColor = vbRed
            Arama.ForeColor = vbWhite
        End If
        
        Say = 0
        Adres = ""
        Adres_Listesi.RemoveAll
    Else
        ListBox1.List = S1.Range("A2:A" & Son).Value
    End If
    
    Set S1 = Nothing
    Set WF = Nothing
    Set Adres_Listesi = Nothing
End Sub
 

nighttorment06

Altın Üye
Katılım
3 Aralık 2018
Mesajlar
28
Excel Vers. ve Dili
Microsoft Office Ev ve İş 2016
Altın Üyelik Bitiş Tarihi
12-10-2027
Arama işlemini düzenledim deneyiniz.

C++:
Sub KayitlariAl()
    Dim S1 As Worksheet, WF As WorksheetFunction, Adres_Listesi As Object
    Dim Adres As String, Aranan_Metin As Variant, Metin_Say As Integer
    Dim Liste As Variant, Son As Long, Veri As Variant, X As Long, Y As Long, Say As Long
   
    Set WF = WorksheetFunction
    Set Adres_Listesi = VBA.CreateObject("Scripting.Dictionary")
   
    Adres = ""
    Metin_Say = 0
    Say = 0
   
    Arama.BackColor = &H80000005
    Arama.ForeColor = vbRed
   
    If Me.OptionButton1.Value = True Then
        Set S1 = Sheets("Parça Listesi")
    ElseIf Me.OptionButton2.Value = True Then
        Set S1 = Sheets("Parça Listesi EUR")
    ElseIf Me.OptionButton3.Value = True Then
        Set S1 = Sheets("İşçilik")
    End If
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
   
    If Len(Arama) > 0 Then
        ListBox1.Clear
       
        Veri = S1.Range("A2:A" & Son).Value
        ReDim Liste(1 To 1, 1 To 1)
       
        Aranan_Metin = Split(WF.Trim(Arama), " ")
       
        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
            Arama.BackColor = vbRed
            Arama.ForeColor = vbWhite
        End If
       
        Say = 0
        Adres = ""
        Adres_Listesi.RemoveAll
    Else
        ListBox1.List = S1.Range("A2:A" & Son).Value
    End If
   
    Set S1 = Nothing
    Set WF = Nothing
    Set Adres_Listesi = Nothing
End Sub

Ustam Allah sizlerden binkere razı olsun zamanınızı emeğiniz verdiniz çok teşekkür ediyorum.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Arama işlemi hem içerir hem de kelime bazlı olmaktadır. Textbox nesnesine yazdığınız kelimeleri tümü eşleşiyorsa sonuç verecektir. Bu detaya dikkat ediniz.
 
Üst