Bul Sorgulama

[musaagac]

arkadaşlar aşağıda yazdığım komutla sorgulama yapıyorum fakat istiyorum ki Başlayan değilde içinde geçen kelimeyi sorgulasın

Mesala = B1 Hücresinde Mehmet Salih ELEMAN yazıyor
sorgulama yaparken Mehmet olarak değilde Salih olarak ta sorgulayabileyim.

Private Sub bul_Click()
Dim say, adet, miktar As Integer
Dim sonuc As String
Dim hucre, hcr As Range

If OptionButton1.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın ismini veya ilk harflerini girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 7).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
bultxt.SetFocus
End If
End If
End If

 

[Emir Hüseyin Çoban]

. . .

Msgboxlara bakılırsa, kodlama tamamen başlar mantığı ile yapılmış.
Aşağıdaki konuyu inceleyiniz. Yardımcı olabilir.

Tıkla ~ Listboxta Çalışma Kitabındaki Sayfaların Tamamını Tek Sayfada Tek Butonla Aramak

. . .

 

[musaagac]

Hocam çözemedim göndermiş olduğum komutdan çözebilirmisiniz ?

 

[Emir Hüseyin Çoban]

. . .

Örnek dosya yok. O yüzden tahmini bir çözüm yazıyorum. Aşağıda belirttiğim satırı ilave ederek deneyiniz.

Private Sub bul_Click()
Dim say, adet, miktar As Integer
Dim sonuc As String
Dim hucre, hcr As Range

If OptionButton1.Value = True Then
If bultxt.Value = Empty Then
MsgBox "Aradığınız kaydın ismini veya ilk harflerini girmelisiniz!..", vbInformation, "Telefon Rehberi"
bultxt.SetFocus
Exit Sub
Else
[B][COLOR="Red"]bultxt.Value = "*" & bultxt.Value & "*"[/COLOR][/B]
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).ClearContents
say = Len(bultxt.Value)
sonuc = Left(bultxt.Value, say)
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If sonuc = Left(hucre, say) Then
hucre.Offset(0, 7).Value = hucre.Value
End If
Next
analist.Clear
For Each hcr In Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2))
If hcr.Value <> "" Then analist.AddItem hcr
Next
Range(Range("I3"), Range("I" & Sayfa1.[A1].Value + 2)).Select
miktar = Application.CountA(Selection)
Label9.Caption = "Aranan kriterde " & miktar & " kayıt bulundu"
If miktar = 0 Then
MsgBox bultxt.Value & " ile başlayan kayıt bulunamadı.", vbInformation, "Telefon Rehberi"
analist.Clear
For Each hucre In Range(Range("B3"), Range("B" & Sayfa1.[A1].Value + 2))
If hucre.Value <> "" Then analist.AddItem hucre
Next hucre
Label9.Caption = "Telefon Rehberi Tüm İsim Listesi"
bultxt.SetFocus
End If
End If
End If

. . .

 

[musaagac]

Örnek Dosya ekte

 

[musaagac]

Şifre 3872529