Klasör içindeki Excel dosyalarında hücre değeri aratma

[o2l3m]

Merhaba;

Aşağıdaki kodu ChatGPT ile yazdırdım. Fakat F sütununa arattığım ve bulduğum değerlerin hücre adreslerini getiremedim.
Yardım edebilir misiniz?

Function GetCellAddress(rowNum As Long, ws As Worksheet) As String
    GetCellAddress = ws.Cells(rowNum, 1).Address
End Function

Sub AramaVeListeleme4()
    Application.ScreenUpdating = False ' Ekran güncellemesini devre dışı bırak
    
    Dim aranan As String
    Dim klasorYolu As String
    Dim dosyaYolu As String
    Dim sonucHucresi As Range
    Dim dosyaAdi As String
    Dim wb As Workbook
    
    ' Aranacak değeri B3 hücresinden al
    aranan = Range("B3").Value
    
    ' Klasör yolunu C3 hücresinden al
    klasorYolu = Range("C3").Value
    
    ' Sonuçları D3 hücresinden başlayarak listeleyeceğimiz hücreyi belirleyin
    Set sonucHucresi = Range("D3")
    
    ' Aranan değer bulunduğunda sayfa adlarını E3 ve sonraki hücrelere yazmak için değişken oluşturun
    Dim sayfaAdi As String
    Dim hucresi As Range ' Hücre adreslerini tutmak için değişken
    
    ' Hücre adreslerini F3 hücresinden başlayarak alt alta sıralı olarak eklemek için başlangıç hücresini belirleyin
    Set hucresi = Range("F3")
    
    ' Dizindeki tüm dosyaları dolaşın
    dosyaYolu = Dir(klasorYolu & "\*.xlsm")
    Do While dosyaYolu <> ""
        ' Dosya adını alın
        dosyaAdi = Mid(dosyaYolu, InStrRev(dosyaYolu, "\") + 1)
        
        ' Dosyayı açın (Salt okunur ve hızlı açma)
        Set wb = Application.Workbooks.Open(Filename:=klasorYolu & "\" & dosyaAdi, ReadOnly:=True, UpdateLinks:=False)
        
        ' Aranan değeri bulmak için sayfaları dolaşın
        For Each ws In wb.Sheets
            ' Aranan değeri sayfada bulunursa
            If WorksheetFunction.CountIf(ws.UsedRange, aranan) > 0 Then
                ' Değerin bulunduğu sayfa adını alın
                sayfaAdi = ws.Name
                
                                ' Dosyanın linkini D3 hücresine ekle
                sonucHucresi.Hyperlinks.Add Anchor:=sonucHucresi, Address:=klasorYolu & "\" & dosyaAdi, TextToDisplay:=dosyaAdi
                
                ' Sayfa adını sonuç hücresine yaz
                sonucHucresi.Offset(0, 1).Value = sayfaAdi
                
                ' Hücre adresini ilgili hücreye yaz
                Dim rowNum As Variant
                rowNum = Application.Match(aranan, ws.UsedRange, 0)
                
                If Not IsError(rowNum) Then
                    Dim cell As Range
                    Set cell = ws.Cells(rowNum, 1)
                    If Not cell Is Nothing Then
                        hucresi.Value = cell.Address
                    Else
                        hucresi.Value = "Bulunamadı"
                    End If
                Else
                    hucresi.Value = "Bulunamadı"
                End If
                
                ' Sonraki satıra geç
                Set sonucHucresi = sonucHucresi.Offset(1)
                Set hucresi = hucresi.Offset(1)
            End If
        Next ws
        
        ' Dosyayı kapatın
        wb.Close SaveChanges:=False
        
        ' Sonraki dosyayı alın
        dosyaYolu = Dir
    Loop
    
    Application.ScreenUpdating = True ' Ekran güncellemesini etkinleştir
    
    ' Arama tamamlandı mesajı
    MsgBox "Arama tamamlandı.", vbInformation
End Sub