• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

KARIŞIK ARAMA YAPABİLME.

Y

yamahato

Altın Üye
Katılım
20 Mayıs 2009
Mesajlar
236
Excel Vers. ve Dili
excel 2007
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 ***************
Private Sub TextBox1_Change()
If Len(TextBox1.Text) = 0 Then
ListBox1.Clear
Exit Sub
End If
Set s1 = Sheets("SAHİBİNDEN")
son = s1.Cells(Rows.Count, "A").End(3).Row
10:
Adet = 0
ListBox1.Clear
For Each hucre In s1.Range("A2:H" & son)
If hucre <> "" Then
Veri = Split(hucre, Chr(10))
For parca = 0 To UBound(Veri)
If UCase(Replace(Replace(Left(Veri(parca), Len(TextBox1)), "ı", "I"), "i", "İ")) = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) Then
Adet = Adet + 1
If Adet > 3000 Then
MsgBox "En az " & Adet & " adetten fazla sonuç bulundu." & Chr(10) & _
"Lütfen 3000 adetten az sonuç bulununcuya kadar karakter girmeye devam ediniz.!", vbInformation
Exit Sub
End If
ListBox1.AddItem (s1.Cells(hucre.Row, "A").Value)
parca = UBound(Veri)
End If
Next
End If
Next
End Sub
Bu kod büyük ve küçük harfle arama yapabiliyor. İşimi görüyor fakat sahibinden sayfasında ki verileri yazıldığı gibi buluyor.
Şöyle örnek vereyim. Diyelim ford focus 2 debriyaj seti yazıyor SAHİBİNDEN sayfasında. biz arama yaparken direk focus yazarsak bunu bulmuyoyor. ve göstermiyor.
bize sadece sahibinden sayfasında başı focusla başlayan aramaları gösteriyor.

Kısacası benim ihtiyacım F yazdığımda sahibinden ne kadar f ile başlayan kelime varsa onun parça kodunu göstermesi. FO yazdığımda sonuçların azalması. Foc yazınca daha da azalması. sonuçta focus yazdığımda sahibinden sayfasında içinde ne kadar focus yazan kod varsa onu göstermesi.
Bu konuda yardımcı olabilirmisiniz?
 
Eşitlik yerine Like kullanırsanız, yıldız ( * ) işareti ile daha esnek bir arama yöntemi kullanırsınız.

C#: 
If UCase(Replace(Replace(Left(Veri(parca), Len(TextBox1)), "ı", "I"), "i", "İ")) Like UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) Then

TextBox örnekler:
- *focus*
- focus*
- *focus
- fo*s
- foc?s
 
Ben yazana kadar Zeki bey gerekli öneriyi yapmış.
Hazır bir şeyleri düzeltmişken paylaşayım.. Sizin kodlarınızı kullandım.

C++: 
Private Sub TextBox1_Change()
Dim hucre As Range, s1 As Worksheet, Kontrol%, Adet%, son&
    If Len(Textbox1.Text) = 0 Then ListBox1.Clear: Exit Sub
    Set s1 = Sheets("SAHİBİNDEN")
    son = s1.Cells(Rows.Count, "A").End(3).Row
    ListBox1.Clear
    For Each hucre In s1.Range("A2:H" & son)
        If hucre <> "" Then
            Kontrol = InStr(1, UCase(Replace(Replace(hucre, "ı", "I"), "i", "İ")), UCase(Replace(Replace(Textbox1.Text, "ı", "I"), "i", "İ")))
            If Kontrol > 0 Then
                Adet = Adet + 1
                If Adet > 3000 Then
                    MsgBox "En az " & Adet & " adetten fazla sonuç bulundu." & Chr(10) & _
                    "Lütfen 3000 adetten az sonuç bulununcuya kadar karakter girmeye devam ediniz.!", vbInformation
                    Exit Sub
                End If
                ListBox1.AddItem (s1.Cells(hucre.Row, "A").Value)
            End If
        End If
    Next
End Sub
 
Zeki Gürsoy' Alıntı:
Eşitlik yerine Like kullanırsanız, yıldız ( * ) işareti ile daha esnek bir arama yöntemi kullanırsınız.

C#: 
If UCase(Replace(Replace(Left(Veri(parca), Len(TextBox1)), "ı", "I"), "i", "İ")) Like UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) Then

TextBox örnekler:
- *focus*
- focus*
- *focus
- fo*s
- foc?s
Genişletmek için tıkla ...

Çok teşekkür ederim.
 
ÖmerFaruk' Alıntı:
Ben yazana kadar Zeki bey gerekli öneriyi yapmış.
Hazır bir şeyleri düzeltmişken paylaşayım.. Sizin kodlarınızı kullandım.

C++: 
Private Sub TextBox1_Change()
Dim hucre As Range, s1 As Worksheet, Kontrol%, Adet%, son&
    If Len(Textbox1.Text) = 0 Then ListBox1.Clear: Exit Sub
    Set s1 = Sheets("SAHİBİNDEN")
    son = s1.Cells(Rows.Count, "A").End(3).Row
    ListBox1.Clear
    For Each hucre In s1.Range("A2:H" & son)
        If hucre <> "" Then
            Kontrol = InStr(1, UCase(Replace(Replace(hucre, "ı", "I"), "i", "İ")), UCase(Replace(Replace(Textbox1.Text, "ı", "I"), "i", "İ")))
            If Kontrol > 0 Then
                Adet = Adet + 1
                If Adet > 3000 Then
                    MsgBox "En az " & Adet & " adetten fazla sonuç bulundu." & Chr(10) & _
                    "Lütfen 3000 adetten az sonuç bulununcuya kadar karakter girmeye devam ediniz.!", vbInformation
                    Exit Sub
                End If
                ListBox1.AddItem (s1.Cells(hucre.Row, "A").Value)
            End If
        End If
    Next
End Sub
Genişletmek için tıkla ...

Teşekkür ederim. Kod güzel çalışıyor.
 
ÖmerFaruk' Alıntı:
Ben yazana kadar Zeki bey gerekli öneriyi yapmış.
Hazır bir şeyleri düzeltmişken paylaşayım.. Sizin kodlarınızı kullandım.

C++: 
Private Sub TextBox1_Change()
Dim hucre As Range, s1 As Worksheet, Kontrol%, Adet%, son&
    If Len(Textbox1.Text) = 0 Then ListBox1.Clear: Exit Sub
    Set s1 = Sheets("SAHİBİNDEN")
    son = s1.Cells(Rows.Count, "A").End(3).Row
    ListBox1.Clear
    For Each hucre In s1.Range("A2:H" & son)
        If hucre <> "" Then
            Kontrol = InStr(1, UCase(Replace(Replace(hucre, "ı", "I"), "i", "İ")), UCase(Replace(Replace(Textbox1.Text, "ı", "I"), "i", "İ")))
            If Kontrol > 0 Then
                Adet = Adet + 1
                If Adet > 3000 Then
                    MsgBox "En az " & Adet & " adetten fazla sonuç bulundu." & Chr(10) & _
                    "Lütfen 3000 adetten az sonuç bulununcuya kadar karakter girmeye devam ediniz.!", vbInformation
                    Exit Sub
                End If
                ListBox1.AddItem (s1.Cells(hucre.Row, "A").Value)
            End If
        End If
    Next
End Sub
Genişletmek için tıkla ...


Hocam ve diğer değerli hocalarım,
Bu aramayı biraz daha dinamik yapabilir miyiz?
Şöyle ki.
FORD FOCUS ARKA KAPI KOLU SOL yazılı olsun bu kodun arama yapıp bulacağı excel sayfasında ki bir hücrede.
Yukarıda ki kod arka yazınca içinde arka yazan bütün parçaları listeliyor. Arka kapı yazınca seçenek azalıyor arka kapı kolu yazınca daha da azalıyor.
ama mesela FOCUS KAPI KOLU YAZINCA HİÇ BİR SONUÇ VERMİYOR.
Bunun nedeni herhalde kodun arama yaptığı sayfada focus kapı kolu diye bir tanım yok.
Bu şekilde de arama yapabilmek adına kodda ne gibi bir değişiklik yapabiliriz?
Yani focus kol yazınca içinde focus ve kol kelimelerin geçtiği bütün hücreleri göstermesini yapabilecek düzeltme mevcut mu?
 
Kodlar çok karışmasın diye Aramayı butona ekledim Daha da geliştirilebilir. Elimde veri olmadığı için saçma sapan değerler girdim sayfaya.
Denemeler yaptım sorun göremedim.
İnceleyin, eksik hata varsa düzeltiriz.

https://dosya.co/sz2arko1q6k7/SahibindenAra.xlsm.html
 

Ekli dosyalar

Metot3 yazan yerden aşağısı
 
Korhan Ayhan' Alıntı:
Bu da alternatif olsun.

Arama kutusuna yazılan tüm kelimeler metin içinde bulunuyorsa bunlar listelenmektedir.
Genişletmek için tıkla ...

Sayın hocam programı indirdir. Sağ olun işime yarayacak yüzde 90 ama söyle bir sorun var. Kendi programımda ki stok isimli userbox1 de ki textbox 1 bunu ne yaptıysam uyduramadım. Excel dosyamı ek'te saf halini ekledim. program çalışma yolu Arama İSİMLİ EXCEL SAYFASINDA Kİ sayfasında ki ANA MENÜ BUTONNUNA BASILCA ÇIKIYOR.
 

Ekli dosyalar

Son düzenleme:
Koray hocam vaktiniz var ise bir üstte ki mesajımı okuyabilir ev sorunma el atarmısınız?
 
Madem kod uyarlama sorununuz var en başında örnek dosyanızı ekleyip yardım talebinde bulunmalıydınız.

Sorunuza 3 kişi cevap verdi. 2 örnek dosya paylaşıldı. Şimdi iş bittikten sonra diyorsunız ki ben dosyama uyarlayamadım. Kusura bakmayın ama bu bizim problemimiz değil ki.

Hem sizin zamanınız boşa gidiyor hem de bizlerin....
 
Korhan Ayhan' Alıntı:
Bu da alternatif olsun.

Arama kutusuna yazılan tüm kelimeler metin içinde bulunuyorsa bunlar listelenmektedir.
Genişletmek için tıkla ...
Korhan Ayhan' Alıntı:
Madem kod uyarlama sorununuz var en başında örnek dosyanızı ekleyip yardım talebinde bulunmalıydınız.

Sorunuza 3 kişi cevap verdi. 2 örnek dosya paylaşıldı. Şimdi iş bittikten sonra diyorsunız ki ben dosyama uyarlayamadım. Kusura bakmayın ama bu bizim problemimiz değil ki.

Hem sizin zamanınız boşa gidiyor hem de bizlerin....
Genişletmek için tıkla ...
Sayın hocam size daha öncede bu konuda bilgi verdim. Dosyada ki bazı bilgilerin yok olması ve kullanıcılarımızın şahsi özel verileri dolayısıyla dosyayı paylaşmak riskli olabilir demiştim. Bu nedenle yaklaşık 3 saat boyunca uğraşmama rağmen uyarlama yapamam sebebi ile ve emeğinize olan saygımdan dolayı dosyamın yaklaşık 2 yıl önceki bir kopyasında gerekli düzenlemeleri yaparak en az verili halini mecburen paylaştım. Taktir edersiniz ki Bu güne kadar verdiğiniz bütün cevapları bir şekilde dosyama uyarladım. Hiç böyle bir talebim olmadı.

Sizi üzdüysem ve kızdırdıysam af edersiniz. Özür dilerim.
Kararınıza saygı duyuyorum.
 
Sizler belki öğrenme arzusu ile böyle sorular soruyorsunuz. Cevabı alırım kendim uyarlarım. Ama keşke öyle herşey çok kolay olsaydı.

Excelin VBA tarafı emek ve zaman ister. Öyle şıp diye olmuyor hiçbir şey.

Örnek dosya konusuna gelince herkes aynı bahaneyi üretiyor ve bu artık hakikaten can sıkıcı bir hal aldı. Altı-üstü boş bir excel dosyasında sayfa ismi aynı verilerinizin bulunduğu alan bilgileri satır sütun bakımından aynı olmak kaydıyla 50-100 satır sanal veri içeren bir dosya paylaşmak. Sonra gerçek veri sayınızı ya da problem yaratacak detayları mesajınızda belirterek yardım talebinde bulunmak.

Böyle olunca soruyu cevaplamak isteyen kişi hem keyif alıyor hem de zaman kaybetmemiş oluyor. Açıkçası ben böyle uzayıp giden başlıkları okuyup zamanımı boşa harcamaktan hiç hoşlanmıyorum.

Umarım ne demek istediğimi net olarak anlatabilmişimdir.
 
Korhan Ayhan' Alıntı:
Madem kod uyarlama sorununuz var en başında örnek dosyanızı ekleyip yardım talebinde bulunmalıydınız.

Sorunuza 3 kişi cevap verdi. 2 örnek dosya paylaşıldı. Şimdi iş bittikten sonra diyorsunız ki ben dosyama uyarlayamadım. Kusura bakmayın ama bu bizim problemimiz değil ki.

Hem sizin zamanınız boşa gidiyor hem de bizlerin....
Genişletmek için tıkla ...

Korhan hocam Örneğinizi kendime uyarlamaya çalıştım ama hata alıyorum.
Kontrol etme şansınız varmı acaba? Arama Fonksiyonu B Sütununda olacak.
Tüm emekleriniz için çok teşekkür ederiz.
 

Ekli dosyalar

"Son" değişkenini kullanmamışsınız. Boş bir değer alıyor. Bu sebeple hata veriyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst