girilen kayıtların toplamını otomatik alma

[blackjacker]

kayıt sekmesınde girilen kayıtların toplamının rapor sekmesınde otomatik çıkmasını nasıl yapabilirim ekteki dosyada adaha açık anlatılıyor

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub toplaSUZ59()
Dim Sh As Worksheet, i As Long, tar As Date
Dim liste(), myarr(), n As Long, z As Object, sat As Long
Sheets("KAYIT").Select
Set Sh = Sheets("RAPOR")
Sh.Range("A2:D" & Rows.Count).ClearContents
liste = Range("A2:D" & Cells(Rows.Count, "A").End(xlUp).Row)
sat = UBound(liste)
ReDim myarr(1 To 3, 1 To sat)
Set z = CreateObject("scripting.dictionary")
For i = 1 To sat
    If Not z.exists(liste(i, 1)) Then
        n = n + 1
        z.Add liste(i, 1), n
        myarr(1, n) = liste(i, 1)
    End If
    myarr(2, z.Item(liste(i, 1))) = myarr(2, z.Item(liste(i, 1))) + liste(i, 2)
    myarr(3, z.Item(liste(i, 1))) = CDbl(myarr(3, z.Item(liste(i, 1)))) + CDbl(liste(i, 4))
Next i
Erase liste
ReDim Preserve myarr(1 To 3, 1 To n)
Application.ScreenUpdating = False
Sh.Range("A2").Resize(n, 3) = Application.Transpose(myarr)
Application.ScreenUpdating = True
Sh.Select
Set z = Nothing
Set Sh = Nothing
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[blackjacker]

tknks

kardeş yinede sağol özet tablodanda aynı şeyi hatta daha kapsamlısını yaptım