Veri karşılaştırma makrosu.

[Carpintero]

Merhaba sayın Ziynettin;
Kod şu hali ile kırmızı verileri üretiyor Mavi verileri de üretebilmesi lazım.
Düzenleme imkanınız olur mu acaba ?

Ekstra açıklama gerekli olur ise grafiklerle yeniden dosya hazırlarım.

 

[Ziynettin]

Sub kod()
son = Cells(Rows.Count, "C").End(3).Row
Set dc = CreateObject("scripting.dictionary")
Set dz = CreateObject("scripting.dictionary")
a = Range("C4:K" & son).Value
    For i = 3 To UBound(a)
        If Not IsEmpty(a(i, 3)) Then
            krt = a(i, 1) & "|" & a(i, 3)
            dc(krt) = i + 3
            
        End If
    Next i
    
    For j = 5 To UBound(a, 2)
        dz(a(1, j)) = ""
    Next j
    

ReDim b(1 To UBound(a) - 2, 1 To 5)
    For i = 3 To UBound(a)
    If Not IsEmpty(a(i, 3)) Then
        For j = 5 To UBound(a, 2)
            krt = a(i, 1) & "|" & a(1, j)
            If dz.exists(a(i, 3)) Then
                b(i - 2, j - 4) = dc(krt)
            End If
        Next j
        End If
    Next i
[G6].Resize(UBound(a) - 2, 5) = b
MsgBox "İşlem bitti.", vbInformation
End Sub

 

[Carpintero]

Tekrardan çok çok teşekkür ederim.
Sayın Ziynettin. İyi ki varsınız.
Elinize emeğinize sağlık.
Bu harika oldu.