iki sayfadaki verileri diğer sayfada icmal

[teknikyapı]

Merhaba.
Eklediğim örnekte daha iyi açıklamaya çalıştım.İlk iki sayfadaki verileri icmal sayfasına aktarıp karşısındaki değerleri yazdırabilirmiyiz.Aslında forumdaki bir örneği uyarlamaya çalıştım ama galiba bizi aştı.Yardımcı olacak arkadaşlara teşekkür ederim.İyi çalışmalar.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub AktarTopla()
Dim a, b, i, n, sat, veri()
Set s1 = Sheets("İSTANBUL")
Set s2 = Sheets("ANKARA")
Set s3 = Sheets("İCMAL")
'*******************************************
a = s1.Range("a2:b" & s1.[a65536].End(3).Row).Value
b = s2.Range("a2:b" & s2.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1) + UBound(b, 1), 1 To 3)
'*******************************************
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
           If Not IsEmpty(a(i, 1)) Then
                 If Not .exists(a(i, 1)) Then
                    n = n + 1
                    veri(n, 1) = a(i, 1)
                    .Add a(i, 1), n
                  End If
                    veri(.Item(a(i, 1)), 2) = veri(.Item(a(i, 1)), 2) + a(i, 2)
                    veri(.Item(a(i, 1)), 3) = veri(.Item(a(i, 1)), 3) + 0
            End If
    Next i
    '*******************************************
    For i = 1 To UBound(b, 1)
           If Not IsEmpty(b(i, 1)) Then
                 If Not .exists(b(i, 1)) Then
                    n = n + 1
                    veri(n, 1) = b(i, 1)
                    .Add b(i, 1), n
                  End If
                    veri(.Item(b(i, 1)), 2) = veri(.Item(b(i, 1)), 2) + 0
                    veri(.Item(b(i, 1)), 3) = veri(.Item(b(i, 1)), 3) + b(i, 2)
            End If
    Next i
End With
'*******************************************
sat = s3.[a65536].End(3).Row + 1
s3.Range(Cells(2, "a"), Cells(sat, "c")).ClearContents
s3.[a2].Resize(n, 3).Value = veri
''*******************************************
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
Set s3 = Nothing
End Sub

 

[teknikyapı]

sn Ripek tam istediğim gibi yardımlarınız için çok teşekkür ederim.İyi çalışmalar.