Tüm Workbook'ta arama yapma

[lelaa]

Merhaba,
ben bir macro yardımıyla tüm workbook'ta (içinde 9 Sheet var) arama yapmak istiyorum. Ama Sheet'ler arasında geçiş yapamıyorum.
ve yapmam gereken bir şey daha, bulduğum sonuçları örneğin bir Listbox'ta veya mesajbox'ta toplu olarak göstermek.
Yardım edebilirseniz çok sevinirim..
Teşekkürler..

 

[Orion1]

Aşağıdaki linkte son mesajlardan birinder ekli dosyalar vardı.Onları inceleyiniz.
http://www.excel.web.tr/f48/arama-butonu-ara-bul-t44152.html

 

[lelaa]

çok teşekkür ederim..
yalnız rica etsem dosyayı bir defa daha yükleyebilir misiniz?
açılmıyor maalesef...

 

[Orion1]

çok teşekkür ederim..
yalnız rica etsem dosyayı bir defa daha yükleyebilir misiniz?
açılmıyor maalesef...

49ncu mesajda arabul59 isimli dosyayı indirebilirsiniz.Ben şimdi indirdim ve denedim.Gayet güzel çalışıyor.

 

[N.Ziya Hiçdurmaz]

yanıt

Küçük bir örnek hazırladım inceleyiniz

Private Sub CommandButton1_Click()
Dim i As Integer
Dim deg As String
ListBox1.Clear
deg = InputBox("aranılan değeri giriniz")
If deg = "" Then ListBox1.Clear: Exit Sub
For i = 1 To Sheets.Count
Set bul = Sheets(i).Cells.Find(deg)
If Not bul Is Nothing Then
ListBox1.AddItem
ListBox1.List(s, 0) = (bul) & "   " & Sheets(i).Name
s = s + 1
End If: Next
End Sub

 

[lelaa]

Evren Bey,
çok teşekkürler, harikalar yaratmışsınız
Tek bir ricam olacak, ilk sayfada ara bul butonunda bir değişiklik yapamıyorum.. (Direk excel üzerine eklenmiş olan)
nasıl yaparım? (Ör: Evren yazısını kaldırmak)
Tekrar teşekkürler

 

[lelaa]

Çok teşekkürler Ziya bey
Gerçekten çok kısa ve süper bir örnek olmuş..
yalnız Listbox'a eklenmiş elemanlara tıklayınca herhangi bir işlem yapılamıyor. Çift tıklayınca o kaydın bulunduğu sayfaya ve hücreye gitmesi mümkün müdür?

 

[Orion1]

Evren Bey,
çok teşekkürler, harikalar yaratmışsınız
Tek bir ricam olacak, ilk sayfada ara bul butonunda bir değişiklik yapamıyorum.. (Direk excel üzerine eklenmiş olan)
nasıl yaparım? (Ör: Evren yazısını kaldırmak)
Tekrar teşekkürler

Tasarım moduna geçin.Sağ tıklayın ve özelliklerden Mouse icon'u bulun ve silin.

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub CommandButton1_Click()
Dim i As Integer
Dim deg As String
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "100,100"
deg = InputBox("aranılan değeri giriniz")
If deg = "" Then ListBox1.Clear: Exit Sub
For i = 1 To Sheets.Count
Set bul = Sheets(i).Cells.Find(deg)
If Not bul Is Nothing Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Name
ListBox1.List(s, 1) = (bul)
s = s + 1
End If: Next
End Sub
Private Sub ListBox1_Click()
Sheets(ListBox1.Text).Select
End Sub

 

[lelaa]

çok teşekkürler Evren Bey ve Ziya Bey
Ziya Bey, Kodunuz çok güzel çalışıyor, yalnız Listeye ekleme kısmıda, sheet'te bulunan bütün kayıtları eklemesini sağlayabilir miyim? (Sadece Sheet ismini değil)

 

[N.Ziya Hiçdurmaz]

yanıt

Sayfalardaki veri arama aralığı(A1:E20)dir siz istediğiniz aralığı kendinize göre değiştirirsiniz

Private Sub CommandButton1_Click()
Dim i As Integer
Dim deg As String
Dim huc As Range
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "75,75"
deg = InputBox("aranılan değeri giriniz")
If deg = "" Then ListBox1.Clear: Exit Sub
For i = 1 To Sheets.Count
For Each huc In Sheets(i).[COLOR="Blue"]Range("a1:e20")[/COLOR]
Set bul = huc.Find(deg)
If Not bul Is Nothing Then
ListBox1.AddItem
ListBox1.List(s, 0) = Sheets(i).Name
ListBox1.List(s, 1) = (bul)
s = s + 1
End If: Next: Next
End Sub
Private Sub ListBox1_Click()
Sheets(ListBox1.Text).Select
End Sub

 

[lelaa]

Çok teşekkürler

 

[N.Ziya Hiçdurmaz]

Birşey değil sayın lelaa