Tarih ve İsim Karşılaştırıp Rakamları getirme makrosu düzenleme hk

[cevahirben]

Merhaba Herkese iyi günler,
Sayfa1 de A sütununda Tarih var, B,C,D..vs.sütunlarda isimler var,
Sayfa2 de A sütununda İsimler var, C sütununda Tarih var, D sütununda da harcamalar var,

benim istediğim Sayfa1 deki A sütunundaki Tarih ile sayfa2 deki c sütunundaki tarihlere bakacak,
sayfa1 deki b,c,d sütunlardaki isimler ile sayfa2 deki a sütunundaki isimlere bakacak
Sayfa1`e sayfa2 deki D sütunundaki HArcama Tutarlarını ilgili tarihin karşısındaki ismin altına getirsin istiyorum.

aşağıdaki kodlamaları buna göre nasıl düzenlemeliyim,yardımlarınızı bekliyorum.
teşekkürler..

Sub deneme()
Dim r As Integer
Dim c As Integer
Dim sonr As Integer
Dim sonc As Integer
Dim a As Range

sonr = Range("A65536").End(xlUp).Row
sonc = Cells(1, Columns.Count).End(xlToLeft).Column

For c = 2 To sonc Step 1
For r = 1 To sonr
For Each a In Sheets(2).Range("C2:C65536").SpecialCells(xlCellTypeConstants)
If Cells(r, 1) = a Then
If Cells(1, c) = a.Offset(0, 1) Then
Cells(r, c) = a.Offset(0, 2)
End If
End If
Next a
Next r
Next c
End Sub

 

[cevahirben]

cevaplarınızı bekliyorum, saygılar....

 

[mersilen]

merhaba
inceleyin

Private Sub CommandButton1_Click()

For a = 2 To 8
adı = Cells(a, "a").Value

t1ts = Sheets("sayfa1").[a2:a10].Find(Cells(a, 3)).Row 'tablo1detarihsatırı
t1as = Sheets("sayfa1").[b1:f1].Find(adı).Column 'tablo1adsütunu
Sheets("sayfa1").Cells(t1ts, t1as) = Cells(a, "d")
Next a

End Sub

 

[Necdet]

Merhaba,

Alternatif olsun, Satır ve Sütun sayısına bağlı olmayan kod.

Sub Doldur()
    
    Dim i   As Long
    
    Dim Sat As Range, _
        Kol As Range
        
    Dim s1  As Worksheet, _
        s2  As Worksheet
        
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
    
    For i = 2 To s2.Cells(Rows.Count, "A").End(3).Row
        Set Sat = s1.Range("A:A").Find(s2.Cells(i, "C"), LookIn:=xlValues)
        If Not Sat Is Nothing Then
            'Tarih Bulundu, Sütun Bulunacak
            Set Kol = s1.Range("1:1").Find(s2.Cells(i, "A"), LookIn:=xlValues)
                If Not Kol Is Nothing Then
                    'Ad Bulundu, Aktarma Yapılıyor
                    s1.Cells(Sat.Row, Kol.Column) = s2.Cells(i, "D")
                Else
                    'Ad Bulunamadı, Mesaj Veriliyor
                    MsgBox s1.Cells(i, "A") & " Adlı Kişi Bulunamadı....", vbCritical
                End If
        Else
            'Tarih Bulunamadı, Mesaj Veriliyor
            MsgBox s1.Cells(i, "C") & " Tarihini Bulamadım...", vbCritical
        End If
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "İŞLEM TAMAMLANMIŞTIR...."
    
End Sub

 

[cevahirben]

arkadaşlar elinize sağlık, teşekkür ederim kodlarınız işime çok yaradı,emeğinize sağlık...