2 Farklı Sayfadaki değerlerin farkını bulma

[İBRAHİMKKS]

Merhaba

Ekli dosyada 2 farklı sayfadaki stokların farkını 3. sayfadaki fark sayfasına makro ile yazdırmak istemekteyim. Konu ile alakalı yardımcı olur musunuz.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[veyselemre]

Sub test()
    Dim lst1, lst2, lst, say, i, sira, ky, kys
    With Sheets("Rapor")
        lst1 = .Range("A3:B" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    With Sheets("DİĞER RAPOR")
        lst2 = .Range("A3:B" & .Cells(Rows.Count, 1).End(3).Row).Value
    End With
    ReDim lst(1 To UBound(lst1) + UBound(lst2), 1 To 4)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(lst1)
            .Item(lst1(i, 1)) = i
            lst(i, 1) = lst1(i, 1)
            lst(i, 2) = lst1(i, 2)
        Next i
        say = i
        For i = 1 To UBound(lst2)
            ky = lst2(i, 1)
            sira = 0
            If .exists(ky) Then
                sira = .Item(ky)
                lst(sira, 3) = lst2(i, 2)
                lst(sira, 4) = lst(sira, 2) - lst(sira, 3)
                .Remove ky
            Else
                lst(say, 1) = lst2(i, 1)
                lst(say, 3) = lst2(i, 2)
                say = say + 1
            End If
        Next i
        If .Count > 0 Then
            kys = .keys
            For i = 0 To UBound(kys)
                lst(say, 1) = kys(i)
                lst(say, 2) = lst1(.Item(kys(i)), 2)
                say = say + 1
            Next i
        End If
    End With
    With Sheets("FARK")
        .Cells.ClearContents
        .Range("A3").Resize(say - 1, 4).Value = lst
    End With
End Sub