Mukayese Makrosu

[Karamanli.70]

Arkadaşlar kolay gelsin. Excelde iki sekme arasında (İki Tarih arasında) mukayese için kullandığım;

=EĞERHATA(İNDİS('14_04_2021'!$D$2:$D$38383;TOPLA.ÇARPIM((KAÇINCI(A2&"@"&B2&"@"&C2;'14_04_2021'!$A$2:$A$38383&"@"&'14_04_2021'!$B$2:$B$38383&"@"&'14_04_2021'!$C$2:$C$38383;0))));" ")

formülü exceli çok kasıyor. Acaba iki sekme arasında mukayese için bir makro kod örneği için yardımcı olabilirmisiniz.

Şimdiden çok teşekkür ederim.

 

[Muzaffer Ali]

Merhaba.
Tam olarak ne yapmak istediğinizi belirtirseniz daha kolay çözüm bulunabilir.

 

[Ziynettin]

Deneyiniz....

Sub test()
Dim s1 As Worksheet, s2 As Worksheet, Krt As String
Dim a(), b(), c(), dc As Object, i As Long
Set s1 = Sheets("24-08-2021")
Set s2 = Sheets("14_04_2021")
Set dc = CreateObject("scripting.dictionary")

a = s1.Range("A2:D" & s1.Range("A" & Rows.Count).End(3).Row).Value
b = s2.Range("A2:D" & s2.Range("A" & Rows.Count).End(3).Row).Value

ReDim c(1 To UBound(a), 1 To 2)

For i = 1 To UBound(b)
    Krt = CStr(b(i, 1)) & "|" & CStr(b(i, 2)) & "|" & CStr(b(i, 3))
    dc(Krt) = b(i, 4)
Next i

For i = 1 To UBound(a)
    Krt = CStr(a(i, 1)) & "|" & CStr(a(i, 2)) & "|" & CStr(a(i, 3))
    If dc.exists(Krt) Then
        c(i, 1) = dc(Krt)
        c(i, 2) = a(i, 4) - dc(Krt)
    Else
        c(i, 1) = 0
        c(i, 2) = 0
    End If
Next i

s1.[E2].Resize(UBound(a), 2).Value = c

MsgBox "İşlem tamam.....", vbInformation
End Sub

 

[Karamanli.70]

Çok teşekkür ederim Ziynettin Bey ellerinize sağlık çok iyi oldu.