Adreslerin Topluca Bulunması

[baydeniro]

Merhaba arkadaşlar. Verilerin bulunduğu hücre adreslerinin topluca bulunması mümkün mü ? Örnek dosya ekte.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

İlk verinin yazılmasını istiyorsanız 1 ya da doğru, yoksa 0 ya da Yanlış yazmanız gerekir.

 Sub AdresBul()
    
    Dim ShL As Worksheet, _
        ShD As Worksheet, _
        c   As Range, _
        i   As Long, _
        Son As Long, _
        Adr As String, _
        ilk As Boolean
    
    ilk = Application.InputBox("İlk Verinin Adresi mi YAZILACAK", "Sorgu", True, Type:=4)
    
    Set ShL = Sheets("LISTE")
    Set ShD = Sheets("DATA")
    
    Application.ScreenUpdating = False
    Son = ShL.Cells(Rows.Count, "B").End(3).Row
    ShL.Range("C2:C" & Son).ClearContents
    
    For i = 2 To Son
        
        With ShD.Range("B:B")
            Set c = .Find(ShL.Cells(i, "B"), LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                ShL.Cells(i, "C") = Replace(c.Address, "$", "")
                If ilk = False Then
                    Do
                        ShL.Cells(i, "C") = Replace(c.Address, "$", "")
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> Adr
                End If
            End If
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "ADRESLER BULUNMUŞTUR....", vbInformation, "Excel.Web.Tr"
    
End Sub

 

[baydeniro]

Sayın Necdet Yeşertener, çok çok teşekkür ederim, müthiş bir kod. Elleriniz dert görmesin.