listede ara karşılığına tarih yaz

[velostar]

Değerli üstadlar, normalde takıldığım konuları sitede araştırarak çözebiliyorum ancak bu sefer bir şekilde kilitlendim. yapmak istediğimi dosyada açıkladım. yardımcı olabilirseniz çok müteşekkir olurum.

 

[EmrExcel16]

Deneyiniz..

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub CommandButton1_Click()

    Dim S2 As Worksheet, i As Long, c As Range, Adr As String
    
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    For i = 2 To S2.Cells(Rows.Count, "C").End(xlUp).Row
        Set c = [A:A].Find(S2.Cells(i, "C"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(c.Row, "D") = Date
                Set c = [A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
    
End Sub

 

[velostar]

Merhaba,

Bu şekilde deneyin.

Private Sub CommandButton1_Click()

    Dim S2 As Worksheet, i As Long, c As Range, Adr As String
   
    Set S2 = Sheets("Sayfa2")
   
    Application.ScreenUpdating = False
    For i = 2 To S2.Cells(Rows.Count, "C").End(xlUp).Row
        Set c = [A:A].Find(S2.Cells(i, "C"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                Cells(c.Row, "D") = Date
                Set c = [A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
   
End Sub

Çok teşekkür ederim.