• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kolon altındaki hücreler içerinde belli kelimeleri bulmak

  • Konbuyu başlatan Konbuyu başlatan search77
  • Başlangıç tarihi Başlangıç tarihi
Katılım
21 Temmuz 2006
Mesajlar
322
Merhaba Arkadaşlar,
Ekli örnek dosyamda belirttim, D kolonunda belirtilen bazı kelimeleri A kolonunda bulup tespit etmek isterim.
Dosyada açıklama olarak belirttim.
Yardımcı olabileceklere şimdiden çok çok teşekkür ederim.
Saygılar.
 

Ekli dosyalar

Aşağıdaki kodları deneyin.
Kod:
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
 
Merhaba,

Aşağıdaki kodlar E sütuna bulduğu satır numarasını ve ilgili hücreye bağlantı kurar.

Kod:
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
 
Arkadaşlar iyi ki varsınız, her iki macroda 0 numara olmuş
Elinize kolunuza emeğinize sağlık
Saygılar
 
Geri
Üst