KARIŞIK ARAMA YAPABİLME.

[1mak1mak]

"Son" değişkenini kullanmamışsınız. Boş bir değer alıyor. Bu sebeple hata veriyor.

Hocam cevabınız için teşekkürler Son değişken derken Sütunları göstermiştim ama tam anlayamadım.
Fısat Bulduğunuzda değişikliği dosya üzerinde uygulama imkanınız olursa sevinirim.
Bu arada bende karşılaştırıp öğrenmiş olurum.
iyi çalışmalar

 

[Korhan Ayhan]

İnceleyiniz.

 

[Korhan Ayhan]

@yamahato,

Siz de aşağıdaki kodu deneyebilirsiniz.

Private Sub TextBox1_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("STOK")
    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
    
    TextBox1.BackColor = &H80000005
    TextBox1.ForeColor = vbRed
    
    ListBox1.Clear
    
    If Len(TextBox1) > 0 Then
        Veri = S1.Range("E2:E" & Son).Value
        ReDim Liste(1 To 1, 1 To 1)
        
        Aranan_Metin = Split(WF.Trim(TextBox1), " ")
        
        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
            TextBox1.BackColor = vbRed
            TextBox1.ForeColor = vbWhite
        End If
        
        Say = 0
        Adres = ""
        Adres_Listesi.RemoveAll
    End If

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

 

[1mak1mak]

İnceleyiniz.

Arama Fonksiyonu aranan kelime içeriğine göre tam bulamıyor. A yazdığımda AESAŞ ı bile bulamıyor.
Sebebi nedir acaba? Birde TUTAR Kısmının sağa yaslanması için ne yapmak lazım.

 

[Korhan Ayhan]

#22 nolu mesajımda ki dosyayı tekrar deneyiniz.

Sizin yaptığınız dosya üzerinden ilerleyince sıkıntı olmuş. Sanırım deneme yaparken X döngüsünün başlangıcını değiştirdiniz.

Benim ilk paylaştığım dosyada yazan ; For X = LBound(Veri, 1) To UBound(Veri, 1)

Sizin paylaştığınız ilk dosyada yazan ; For X = LBound(Veri, 2) To UBound(Veri, 2)

Bende buraya dikkat etmeyince arama yapmaması kaçınılmaz olmuş.

 

[1mak1mak]

#22 nolu mesajımda ki dosyayı tekrar deneyiniz.

Sizin yaptığınız dosya üzerinden ilerleyince sıkıntı olmuş. Sanırım deneme yaparken X döngüsünün başlangıcını değiştirdiniz.

Benim ilk paylaştığım dosyada yazan ; For X = LBound(Veri, 1) To UBound(Veri, 1)

Sizin paylaştığınız il dosyada yazan ; For X = LBound(Veri, 2) To UBound(Veri, 2)

Bende buraya dikkat etmeyince arama yapmaması kaçınılmaz olmuş.

Teşekkür ederim ellerinize sağlık şimdi güzel çalışıyor.
Tutar kısmının sağa yaslanması için kodda nasıl bir değişiklik yapmam gerekiyor acaba?
Birde fazla oluyorum ama bulunanları dışarı farklı bir excel dosyası olarak ListBox üzerine Alta Buton ekleyerek kaydettirmek mümkünmü?

 

[Korhan Ayhan]

Listbox nesnesinde sütun bazlı hizalama yapamazsınız. Sağa yaslı dediğinizde tüm sütunlar sağa yaslı olur. Bu da hoş durmaz.

Diğer sorunuz için ayrı başlık açmalısınız.

 

[1mak1mak]

Listbox nesnesinde sütun bazlı hizalama yapamazsınız. Sağa yaslı dediğinizde tüm sütunlar sağa yaslı olur. Bu da hoş durmaz.

Diğer sorunuz için ayrı başlık açmalısınız.

Evet bende yapmaya çalıştım ama Tüm listeleri aşağıdaki Kod Sağa alıyor ama hoş olmuyor.

ListBox1.TextAlign = fmTextAlignRight

Bir yerde şöyle bir Kod buldum ayrı ayrı Sağa Sola yapmış ama bu listeye uyarlayamadım.

Private Sub CommandButton1_Click()
With Me.ListView1
    .ListItems.Clear
    .ColumnHeaders.Clear
    .View = lvwReport
    .ColumnHeaders.Add , , "Adi", 60, lvwColumnLeft
    .ColumnHeaders.Add , , "Soyadi", 60, lvwColumnLeft
    .ColumnHeaders.Add , , "Bolum", 50, lvwColumnCenter
    .ColumnHeaders.Add , , "Puan", 60, lvwColumnRight
    .ListItems.Add , , "Excel"
    .ListItems(1).SubItems(1) = "Vba"
    .ListItems(1).SubItems(2) = "Office"
    .ListItems(1).SubItems(3) = "125.19"
End With
End Sub

 

[Korhan Ayhan]

ListView <> ListBox bunlar iki farklı nesnedir.

ListBox yerleşik bir componentdir. ListView ise genellikle 32 Bit ofis sürümlerinde sorunsuz çalışan bir componentdir. Bu sebeple ben kullanmayı pek tercih etmiyorum.

Forumda bu iki nesne ile onlarca konu var. Arama yapmalısınız.

 

[muhsinde]

Bu formda sütun sayısını 14 e çıkarabilirmiyiz.

 

[Korhan Ayhan]

Bu talebiniz hangi dosya için?

 

[muhsinde]

#22 nolu mesajdaki dosya için

 

[muhsinde]

Cevap Yokmu ???

 

[Korhan Ayhan]

Çıkarabilirsiniz.

Kod bölümünde değişiklikler yapmalısınız. Tek tek yazmak zaman alacaktır. Bu sebeple örnek dosyanızda userformunuzu tasarlayıp hazır olarak paylaşırsanız kodlar uyarlanabilir.

 

[muhsinde]

Korhan Ayhan Üstat dosyayı ekliyorum.

 

[Korhan Ayhan]

Dosyanız ektedir.

 

[muhsinde]

@Korhan Ayhan Üstat Allah razı olsun, teşekkürler, her şey gönlünce olsun.

 

[muhsinde]

@Korhan Ayhan Üstat
Satır sayısı fazlalaştığında overflow hatası veriyor.

 

[Korhan Ayhan]

Hangi değişken için owerflow hatası alıyorsunuz?

 

[muhsinde]

Aramayı başka bir forma entegre ettiğimde run time error 6 overflow hatası veriyor.