Listbox içerisinde arama

[nighttorment06]

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 ?

 

[Korhan Ayhan]

Linklerden faydalanabilirsiniz.

KARIŞIK ARAMA YAPABİLME.

Merhaba. Öncelikle sayenizde git gide adım adım daha güzel bir userforms oluşuyor. Şimdi bir konuda daha yardımınıza ihtiyacım var. Malum daha önce büyük harf küçük harf ayrımını çözdük. Sorunum şimdi şu. Aşağıda ki kod benim arama Textbok'umda ki kod. ' *************** TextBox1 DE ARAMA...

www.excel.web.tr

listview da stabil hızlı bir arama şekli

hayırlı geceler listview dosyamı ekledim uzun verilerde stabil arama yapabileceğim bir kod yardımlarınızı bekliyorum :)

www.excel.web.tr

 

[nighttorment06]

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]

Linklerden faydalanabilirsiniz.

KARIŞIK ARAMA YAPABİLME.

Merhaba. Öncelikle sayenizde git gide adım adım daha güzel bir userforms oluşuyor. Şimdi bir konuda daha yardımınıza ihtiyacım var. Malum daha önce büyük harf küçük harf ayrımını çözdük. Sorunum şimdi şu. Aşağıda ki kod benim arama Textbok'umda ki kod. ' *************** TextBox1 DE ARAMA...

www.excel.web.tr

listview da stabil hızlı bir arama şekli

hayırlı geceler listview dosyamı ekledim uzun verilerde stabil arama yapabileceğim bir kod yardımlarınızı bekliyorum :)

www.excel.web.tr

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]

Merhaba;

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

 

[nighttorment06]

Merhaba Konu halen çözülememiştir yardım edebilecek varmı lütfen

 

[Korhan Ayhan]

Arama işlemini düzenledim deneyiniz.

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]

Arama işlemini düzenledim deneyiniz.

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]

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.