Çalışma kitabının tüm sayfalarında arama yapmak

Erdal

Altın Üye
Katılım
23 Ekim 2006
Mesajlar
1,049
Excel Vers. ve Dili
Ev: 2021 - Türkçe 32 Bit
İşyeri: 2016 - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
08-10-2029
Merhabalar
Aşağıdaki kod ile çalışma kitabındaki tüm sayfaların A:C sütunlarında tam arama yapabiliyorum. Ama … içerir ve … ile başlayan mantıklarıyla arama yaptıramadım. Örnek dosya ektedir. Acaba yardımcı olabilir misiniz? Saygı ve selam ile ...

Kod:
Private Sub CommandButton1_Click()
Dim k As Range, adr As String
ListBox1.Clear
If TextBox1.Text = "" Then Exit Sub
For i = 1 To Worksheets.Count
    Set k = Sheets(i).Range("A:C").Find(TextBox1.Text, , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            ListBox1.AddItem
            ListBox1.Column(0, ListBox1.ListCount - 1) = Sheets(i).Name
            ListBox1.Column(1, ListBox1.ListCount - 1) = k.Address
            ListBox1.Column(2, ListBox1.ListCount - 1) = k.Value
            Set k = Sheets(i).Range("A:C").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next i
Set k = Nothing
End Sub
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,765
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İçerir;
C++:
Private Sub CommandButton1_Click()
Dim k As Range, adr As String
ListBox1.Clear
If TextBox1.Text = "" Then Exit Sub
For i = 1 To Worksheets.Count
    Set k = Sheets(i).Range("A:C").Find(TextBox1.Text, , xlValues, xlPart)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            ListBox1.AddItem
            ListBox1.Column(0, ListBox1.ListCount - 1) = Sheets(i).Name
            ListBox1.Column(1, ListBox1.ListCount - 1) = k.Address
            ListBox1.Column(2, ListBox1.ListCount - 1) = k.Value
            Set k = Sheets(i).Range("A:C").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next i
Set k = Nothing
End Sub
İle başlar;
C++:
Private Sub CommandButton1_Click()
Dim k As Range, adr As String
ListBox1.Clear
If TextBox1.Text = "" Then Exit Sub
For i = 1 To Worksheets.Count
    Set k = Sheets(i).Range("A:C").Find(TextBox1.Text & "*", , xlValues, xlWhole)
    If Not k Is Nothing Then
        adr = k.Address
        Do
            ListBox1.AddItem
            ListBox1.Column(0, ListBox1.ListCount - 1) = Sheets(i).Name
            ListBox1.Column(1, ListBox1.ListCount - 1) = k.Address
            ListBox1.Column(2, ListBox1.ListCount - 1) = k.Value
            Set k = Sheets(i).Range("A:C").FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
    End If
Next i
Set k = Nothing
End Sub
 

Erdal

Altın Üye
Katılım
23 Ekim 2006
Mesajlar
1,049
Excel Vers. ve Dili
Ev: 2021 - Türkçe 32 Bit
İşyeri: 2016 - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
08-10-2029
Ancak bakma şansı bulabildim. Teşekkür ederim Korhan Bey istediğim gibi olmuş. Hakkınızı helal edin.
 

Erdal

Altın Üye
Katılım
23 Ekim 2006
Mesajlar
1,049
Excel Vers. ve Dili
Ev: 2021 - Türkçe 32 Bit
İşyeri: 2016 - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
08-10-2029
Dosyanın son halini ekliyorum. Belki faydalanan olur.
 

Ekli dosyalar

Üst