LİSTBOXTA KAREKTER BULMA

Katılım
6 Ocak 2006
Mesajlar
11
LÝSTBOXTA KAREKTER BULMA

Aşşağıdaki kod textboxtaki karekterlerden hangisi aratılırsa buluyor ACABA listbox içinde böyle bir kod varmı saygıdeğer üstatlarıma rica ediyorum.


Dim A As Integer

Private Sub CommandButton1_Click()
Static say As Byte
txt = TextBox1.Text
If say > 0 Then GoTo atla
ara = InputBox("Aramak istediğiniz kelimeyi seçin")
TextBox1.Text = WorksheetFunction.Substitute(txt, vbCrLf, " ")
If InStr(1, txt, ara, vbTextCompare) > 0 Then
A = InStr(1, txt, ara, vbTextCompare)
TextBox1.SetFocus
TextBox1.SelStart = A - 1
TextBox1.SelLength = Len(ara)
say = say + 1
Exit Sub
Else
MsgBox "Aradığınız kelime bulunamadı", vbCritical
Exit Sub
End If
atla:
Cevap = MsgBox("Aramaya devam etmek için EVET" & vbCrLf & "Yeni arama için İPTAL tıklayın", vbQuestion + vbYesNo)
If Cevap = vbNo Then GoTo Son
If InStr(A + 1, txt, ara, vbTextCompare) > 0 Then
A = InStr(A + 1, txt, ara, vbTextCompare)
TextBox1.SetFocus
TextBox1.SelStart = A - 1
TextBox1.SelLength = Len(ara)
Else: MsgBox "Aradığınız kelime bulunamadı", vbCritical: say = 0
End If
Exit Sub
Son:
say = 0
End Sub
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Böyle bir kod yazılabilir, ama daha karmaşık bir kod olacaktır. Bir örnek dosya eklerseniz onun üzerinden gidebiliriz.
 
Katılım
6 Ocak 2006
Mesajlar
11
yanıt

Sayın levent bey Bir örnek ekledim yardımlarınızı bekliyorum teşekkürler.
 
Katılım
3 Nisan 2005
Mesajlar
347
Excel Vers. ve Dili
office xp tr
yanıt

İstenen sütundaki veriler ister sağında ister solunda veya ortada olsun verileri bulur listboxta gösterir.

Private Sub ComboBox1_Change()
On Error Resume Next
ComboBox1 = Replace(ComboBox1, "İ", "i")
ComboBox1 = Replace(ComboBox1, "I", "ı")
ComboBox1 = LCase(ComboBox1)
Dim MyRng As Range
ListBox1.Clear
If Len(ComboBox1) > 0 Then
For Each MyRng In ActiveSheet.Range("B1:B5000")
If LCase(MyRng.Text) Like "*" & ComboBox1 & "*" Then ListBox1.AddItem MyRng
Next
End If
End Sub
 
Üst