otomatik veri aktarımı

[The_Game]

merhabalar
data1 den data 2 ye Süzerek A B C tablolarına toplamlarının gelmesi için ne yapmam gerekiyor.

saygılar.

 

[Recep İpek]

Merhaba,

Fonksiyonlarla yapılması biraz uzun ve dosyanızda da fazla veri varsa makro ile çözüm aramanız daha uygun olacaktır.

Bunun için aşağıdaki kodları kullanabilirsiniz.

Sub AktarTopla()
Dim a, i, n, k, b()
Set s1 = Sheets("DATA1")
Set s2 = Sheets("DATA2")
'*******************************************
a = s1.Range("a5:e" & s1.[a65536].End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 6)
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)
                    b(n, 3) = a(i, 2)
                    .Add a(i, 1), n
                End If
                    b(.Item(a(i, 1)), 4) = b(.Item(a(i, 1)), 4) + a(i, 3)
                    b(.Item(a(i, 1)), 5) = b(.Item(a(i, 1)), 5) + a(i, 4)
                    b(.Item(a(i, 1)), 6) = b(.Item(a(i, 1)), 6) + a(i, 5)
                End If
    Next
End With
s2.Range("a6:F100").ClearContents
s2.[a6].Resize(n, 6).Value = b
'*******************************************
MsgBox "Bitti"
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[Ali]

Data2'deki B6 hücrenize

=TOPLA.ÇARPIM((DATA1!$A$5:$A$13=$A6)*(DATA1!$C$4:$E$4=B$5);DATA1!$C$5:$E$13)

yazıp sağa ve aşağı doğru çekerek tablonuzu doldurunuz.