sayfa 1 deki tutarları isme göre 2 nci sayfada toplama

[aslanturk58]

arkadaşlar örnek yaptığım çalışmada anlattığım gibi bir makro yada formul olabilirmi eğer bakarsanız çok menun olurum.

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub AktarSay()
Dim a, i, n, b()
Set s1 = Sheets("kayıt")
Set s2 = Sheets("özet")
'*******************************************
a = s1.Range("b4:c" & s1.[c65536].End(3).Row).Value
ReDim b(1 To UBound(a, 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
                    b(n, 1) = n
                    b(n, 2) = a(i, 1)
                    .Add a(i, 1), n
                  End If
                    b(.Item(a(i, 1)), 3) = b(.Item(a(i, 1)), 3) + a(i, 2)
            End If
    Next
End With
'*******************************************
son = s2.[a65536].End(3).Row + 1
s2.Range(Cells(2, "a"), Cells(son, "c")).ClearContents
s2.[a2].Resize(n, 3).Value = b
'*******************************************
MsgBox "Bitti"
s2.Select
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[aslanturk58]

teşşeküür ederim ilginiz için hemen ekliycem.

 

[aslanturk58]

kardeş ben biraz önce soruyu yanlış anlattım kendi dosyamı gönderiyorum bir bakarsan memnun olurum.

 

[Recep İpek]

Ekli dosyayı inceleyiniz.

 

[aslanturk58]

çok teşşekkür ederim sorunum çözüldü bu çok iyi oldu. saygılar.