mükerrer aktarma

[mesudiye_052]

Selamlar;

aşağıdaki makroyu detaylı anlatabilirmisiniz


Dim a, b, i, n, sat, veri()
Set s1 = Sheets("data")
Set s2 = Sheets("liste")
'*******************************************
a = s1.Range("a2:c" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1), 1 To 4)
'*******************************************
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
z = a(i, 1) & ":" & a(i, 2)
If Not IsEmpty(z) Then
If Not .exists(z) Then
n = n + 1
.Add z, n
veri(n, 1) = n
veri(n, 2) = a(i, 1)
veri(n, 3) = a(i, 2)
End If
veri(.Item(z), 4) = veri(.Item(z), 4) + a(i, 3)
End If
Next i
End With
'*******************************************
sat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(2, "a"), s2.Cells(sat, "d")).ClearContents
s2.[a2].Resize(n, 4).Value = veri
''*******************************************
s2.Select
MsgBox "Raporlama Tamamlandı", vbInformation, "Bilgi"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[mesudiye_052]

Selamlar;

yukarıdaki kodu satır satır anlatırsanız sevinirim


Teşekkürler

 

[mesudiye_052]

Selamlar;

Yardımcı olan yokmu

 

[mesudiye_052]

Selam;

yardımcı olan varmı