DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub askm()
Dim ara As Range
Dim ilkadres As String
Dim son1 As Long, son2 As Long
son1 = Range("A" & Rows.Count).End(3).Row
son2 = Range("D" & Rows.Count).End(3).Row
With Range("A1:A" & son1)
For i = 2 To son2
Set ara = .Find(Cells(i, "D"), LookIn:=xlValues)
If Not ara Is Nothing Then
ilkadres = ara.Address
Do
Cells(ara.Row, 1).Interior.Color = vbYellow
Set ara = .FindNext(ara)
Loop While Not ara Is Nothing And ara.Address <> ilkadres
End If
Next i
End With
MsgBox "İşlem tamam", vbInformation, Application.UserName
End Sub
Sub Bul()
Dim i As Integer, _
c As Range, _
Adr As String
ActiveSheet.Hyperlinks.Delete
Range("E:E").ClearContents
For i = 2 To Cells(Rows.Count, "D").End(3).Row
Set c = Range("A:A").Find(Cells(i, "D"), LookAt:=xlPart)
If Not c Is Nothing Then
Cells(i, "E") = c.Row
ActiveSheet.Hyperlinks.Add Range("E" & i), Address:="", _
SubAddress:="'" & Sayfa1.Name & "'!" & Replace(c.Address, "$", "") ', TextToDisplay:="Click Here to Go to Sheet2, cell B2 of the same workbook"
End If
Next i
End Sub