CTRL+ F ile tüm sayfalarda arama ve listeleme

[waytooraider]

Merhaba,
CTRL+F komutuyla tüm sayfalarda tümünü bul dedikten sonra çıkan arama sonuçlarını raporlamak listelemek istiyorum, mutalak sorulmuştur ama ben bulamadım arşivden saygılar herkese.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle ekleyip deneyiniz.

Sayfa1'De A sütununda Sayfa Adlarını, B sütununda bulduğu hücrenin adresini listeler.
Sayfa1'deki E2 hücresindeki değeri arar.

Gerekirse kodları kendinize göre uyarlayınız.

Sub TumSayfalardaBul()

    Dim Syf As Worksheet, _
        Ws  As Worksheet, _
        c   As Range, _
        Adr As String, _
        i   As Long, _
        Ara As String
    
    Set Ws = Sheets("Sayfa1")
    Ara = Ws.Range("E2").Value
    
    i = 1
    
    For Each Syf In Worksheets
    
        Set c = Nothing
        Adr = ""
        
        If Syf.Name <> Ws.Name Then
        
            With Syf.Cells
                Set c = .Find(Ara, LookIn:=xlValues, LookAt:=xlWhole)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        i = i + 1
                        Ws.Cells(i, "A") = Syf.Name
                        Ws.Cells(i, "B") = c.Address
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
        
        End If
        
    Next Syf
    
End Sub

 

[waytooraider]

Çok güzel çalışma, e2 de yazlını,diğer sayfalarda hücre içerisinde içeriyorsada listelese olurmu örnek verecek olursam, Sayfa1 E2 hücresine MYD yazıcam sayf4 de MYD-FD-01, sayfa 5de FD-MYD-02 nin geçtiği hucreyide linklese olurmu? Sanırım diğer sayfalarda sadece MYD yazıyorsa onu listeliyor.

 

[Necdet]

Merhaba,

Kodları aşağıdaki gibi kullanın, iki kod arasındaki farkı inceleyin.
Not : Adres ve değeri birlikte yazdırdım.

Sub TumSayfalardaBul()

    Dim Syf As Worksheet, _
        Ws  As Worksheet, _
        c   As Range, _
        Adr As String, _
        i   As Long, _
        Ara As String
   
    Set Ws = Sheets("Sayfa1")
    Ara = Ws.Range("E2").Value
   
    i = 1
   
    For Each Syf In Worksheets
   
        Set c = Nothing
        Adr = ""
       
        If Syf.Name <> Ws.Name Then
       
            With Syf.Cells
                Set c = .Find(Ara, LookIn:=xlValues, LookAt:=xlPart)
                If Not c Is Nothing Then
                    Adr = c.Address
                    Do
                        i = i + 1
                        Ws.Cells(i, "A") = Syf.Name
                        Ws.Cells(i, "B") = c.Address
                        Ws.Cells(i, "C") = c
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End With
       
        End If
       
    Next Syf
   
End Sub

 

[ceysuhan]

Merhaba, Makroyu yapan arkadaşa çok teşekkür ederim.
Makroyu kendi dosyamda kullandım tam istediğim gibi ama Bu makroda excel dosyamda bulunan ilk 10 sayfada arama yapmaması ve arama yaptığı sayfalardada a19 hücresi dahil aşağı doğru araması için ne gibi değişiklikler yapmak gerekir yardımcı olursanız sevinirim

 

[Korhan Ayhan]

@Necdet beyin kodlarını aşağıdaki gibi revize edip kullanabilirsiniz.

Option Explicit

Sub IstenenSayfalardaBul()
    Dim Syf As Worksheet, _
        Ws  As Worksheet, _
        c   As Range, _
        Adr As String, _
        i   As Long, _
        Ara As String, _
        X As Integer
  
    Set Ws = Sheets("Sayfa1")
    Ara = Ws.Range("E2").Value
  
    i = 1
  
    For X = 11 To Worksheets.Count
        Set c = Nothing
        Adr = ""
        Set Syf = Sheets(X)
       
        With Syf.Range("A19:A" & Syf.Rows.Count)
            Set c = .Find(Ara, LookIn:=xlValues, LookAt:=xlPart)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    i = i + 1
                    Ws.Cells(i, "A") = Syf.Name
                    Ws.Cells(i, "B") = c.Address
                    Ws.Cells(i, "C") = c
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
    Next
  
    MsgBox "Aramam işlemi tamamlanmıştır.", vbInformation
End Sub

 

[igultekin2000]

@Necdet beyin kodlarını aşağıdaki gibi revize edip kullanabilirsiniz.

İyi günler, çok kullanışlı bir kod, aranan değerin bulunmasına ilave olarak, bulunan değerin yanındaki iki hücreyi de Sayfa1' getirmek gibi bir ilave mümkün olabilir mi? Teşekkürler.

 

[ceysuhan]

Çok teşekkür ederim tam istediğim gibi çalışıyor.