Ara bul

[teknikyapı]

Merhaba
Aşağıdaki kod ile Textbox daki yazılı olan veriyi hücrede arama yaptırıyoruz ama aramak istediğimiz cümleleri tam yazmaksak (örneğin ; hücrede "Boyacı Ustası" yazıyor
biz textboxa " Boya usta" yazarsak arama maelesef gerçekleşmiyor.Find.ler ile biraz aradım ama bulmadım.
Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

Set SR = Sheets("fiyat")

If TextBox7 = "" Then Exit Sub
ListView1.ListItems.Clear
Set ALAN = Range("A3:G" & [a65536].End(3).Row)
Set BUL = ALAN.Find("*" & TextBox7.Text & "*")

If TextBox7 = "" Then Exit Sub
If Not BUL Is Nothing Then
Adres = BUL.Address
Do
satır = BUL.Row
With ListView1
.ListItems.Add , , SR.Cells(satır, 1)
X = X + 1
.ListItems(X).ListSubItems.Add , , SR.Cells(satır, 2)
.ListItems(X).ListSubItems.Add , , SR.Cells(satır, 3)
.ListItems(X).ListSubItems.Add , , Format(SR.Cells(satır, 4), "#,##0.00")
.ListItems(X).ListSubItems.Add , , SR.Cells(satır, 5)
.ListItems(X).ListSubItems.Add , , SR.Cells(satır, 6)
.ListItems(X).ListSubItems.Add , , SR.Cells(satır, 7)
SAY = SAY + 1

 

[PLİNT]

Merhaba
Aşağıdaki şekilde "textbox" 'a boşluk karakteri eklendiğinde; "*" ile değiştirilerek yapılabilir.
ListView1.ListItems.Clear
Set alan = sr.Range("A3:G" & [a65536].End(3).Row)
Dim aranan As String
aranan = "*" & TextBox7.Text & "*"
If InStr(1, TextBox7.Text, Chr(32), vbTextCompare) <> "" Then aranan = Replace(aranan, Chr(32), Chr(42))
Set bul = alan.Find(aranan)

If TextBox7 = "" Then Exit Sub




Ayrıca arama yapılan "ALAN" önünde sayfa tanımı eksik gibi görünüyor, sayfa aktif olmadığında sıkıntı çıkarmasın
Set ALAN = sr.Range("A3:G" & [a65536].End(3).Row)

 

[teknikyapı]

Sn.PLİNT Arkadaşım mükemmel çalıştı.
Teşekkür ederim.

 

[PLİNT]

Rica ederim.
Yukarıdaki kodlarda eşitsizliği sıfır yapalım;
If InStr(1, TextBox7.Text, Chr(32), vbTextCompare) <> 0

Alternatif olarak; veriler fazla ise biraz daha hızlı olur düşüncesi ile; kodlardaki, aşağıdaki düzenlemeyi deneyebilirsiniz.

Aranan kelime veya cümlelerin sadece "B" sütununda olduğunu varsayarak;
ilk kelimeyi arayıp listeyi doldurur boşluk/boşluklar ile eklenen kelimelere göre; (sayfada tekrar arama yapmadan) listeden uymayanları ayrı kod ile siler

Set sr = Sheets("fiyat")
If TextBox7 = "" Then Exit Sub
Set alan = sr.Range("B3:B" & [a65536].End(3).Row)
Dim aranan As String
aranan = "*" & TextBox7.Text & "*"
If UBound(Split(aranan, " ")) <> 0 Then
Call texs:
Exit Sub
End If
ListView1.ListItems.Clear
Set bul = alan.Find(aranan)
If TextBox7 = "" Then Exit Sub
'....
'....diğer kodlar
'......

Sub texs()

With ListView1
On Error Resume Next
For Z = .ListItems.Count To 1 Step -1
For t = 0 To UBound(Split(TextBox7.Text, " "))
If IsEmpty(Split(TextBox7, " ")(t)) = False And Split(.ListItems(Z).ListSubItems(1).Text, " ")(t) Like Split(TextBox7, " ")(t) & "*" = False Then
.ListItems.Remove (Z)
End If
Next: Next
End With
End Sub

 

[teknikyapı]

Merhaba
Aşağıdaki şekilde "textbox" 'a boşluk karakteri eklendiğinde; "*" ile değiştirilerek yapılabilir.
ListView1.ListItems.Clear
Set alan = sr.Range("A3:G" & [a65536].End(3).Row)
Dim aranan As String
aranan = "*" & TextBox7.Text & "*"
If InStr(1, TextBox7.Text, Chr(32), vbTextCompare) <> "" Then aranan = Replace(aranan, Chr(32), Chr(42))
Set bul = alan.Find(aranan)

If TextBox7 = "" Then Exit Sub




Sn.PLİNT ve Arkadaşlar ,

Gayet iyi çalışan yukarıdaki kodlara şöyle bir ilave yapılabilir mi acaba ?
Texboxt'a yazılan kelimeleri ayrı ayrı kendisini ve benzerini ("A3:G" & [a65536].End(3).Row) aralığında arayacak ve bulunan satırları listeleyecek.
Örneğin ; Textboxt'a yazılan "Elma Armut Portakal " gibi bir aramada Elma'nın Armut'un Portakal'ın bulunduğu satırları ( eğer herhangi biri var ise) listelesin.
Yardımlarınız için şimdiden teşekkür ederim.

 

[teknikyapı]

Merhaba
Değerli Arkadaşlar hala çözemedim yardımlarınızı bekliyorum

 

[Korhan Ayhan]

Sanırım benzer bir konu.. İnceleyiniz.

listboxta uzun cümlede iki ayrı kelime ile süzme

HERKESE İYİ AKŞAMLAR, LUG TİPİ KELEBEK VANA ÇAP DN25 PASLANMAZ KÜRESEL VANA ÇAP DN20 LUG TİPİ KELEBEK VANA ÇAP DN20 WAFER TİPİ VANA ÇAP DN25 BU TARZ ÇOK KELİMELİ SATIRLAR İÇEREN TABLODAN TEXTBOX YARDIMIYLA LİSTBOXA SÜZME İŞLEMİ YAPIYORUM. MESELA LUG DN25 YAZDIĞIM ZAMAN BU İKİ KELİMEYİ...

www.excel.web.tr

 

[teknikyapı]

Sn.Korhan Ayhan çok teşekkür ederim,
Tam aradığım gibi görünüyor ama çok teknik bir konu olduğu için anlayabilmem ve ezbere olmaması için aşağıdaki kodların yanına açıklamalarını yazarmısınız ?

If InStr(1, TextBox1, " ") = 0 Then
If InStr(1, UCase(Replace(Replace(sh.Range("y" & satır), "ı", "I"), "i", "İ")), TextBox1) > 0 Then
ListBox1.AddItem


If InStr(1, TextBox1, " ") = 0 Then
If InStr(1, UCase(Replace(Replace(sh.Range("y" & satır), "ı", "I"), "i", "İ")), TextBox1) > 0 Then
ListBox1.AddItem

 

[Korhan Ayhan]

1. Satır: Textbox1 nesnesinde boşluk karakteri yoksa sorgusu yapılıyor.

2. Satır: sh isimli sayfada Y sütununda ki ilgili satırda TextBox1 nesnesinde ki değer varmı sorgusu yapılıyor.

3. Satır: Listbox1 nesnesine kayıt eklemek için kullanılmaktadır

 

[teknikyapı]

Sn.Korhan Ayhan,

Konuyu aşağıdaki linkteki yerde soracaktım kusura bakmayın

listboxta uzun cümlede iki ayrı kelime ile süzme

HERKESE İYİ AKŞAMLAR, LUG TİPİ KELEBEK VANA ÇAP DN25 PASLANMAZ KÜRESEL VANA ÇAP DN20 LUG TİPİ KELEBEK VANA ÇAP DN20 WAFER TİPİ VANA ÇAP DN25 BU TARZ ÇOK KELİMELİ SATIRLAR İÇEREN TABLODAN TEXTBOX YARDIMIYLA LİSTBOXA SÜZME İŞLEMİ YAPIYORUM. MESELA LUG DN25 YAZDIĞIM ZAMAN BU İKİ KELİMEYİ...

www.excel.web.tr