Excel de üretim kaydı ile ilgili bir soru

[fibeks]

Merhabalar Ekte gönderdiğim gibi bir liste olsun elimizde bu listeyi kullanarak girişleri ayrı bir sayfa kaydetsin ve kaydettiği listeye örnek 2 hafta sonra baktığımda listedeki değerler tüm kaydedilen haftaların resim numarasına göre toplamını versin exelde de anlatmaya çalıştım şimdiden yardımınız için teşekkürler

 

[asi_kral]

Merhabalar Ekte gönderdiğim gibi bir liste olsun elimizde bu listeyi kullanarak girişleri ayrı bir sayfa kaydetsin ve kaydettiği listeye örnek 2 hafta sonra baktığımda listedeki değerler tüm kaydedilen haftaların resim numarasına göre toplamını versin exelde de anlatmaya çalıştım şimdiden yardımınız için teşekkürler

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub kaydet_topla_1967()
'Konu       :   Girilen Değere göre Kaydet ve Topla
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi, kral
Dim a, b, c, d
Set asi = Sheets("Giriş")
Set kral = Sheets("kaydedilen veriler")
kral.Range("A6:H" & Rows.Count).ClearContents
c = 6
For a = 6 To asi.Cells(Rows.Count, "C").End(xlUp).Row
d = 0
If WorksheetFunction.CountIf(asi.Range("C3:C" & a), _
asi.Cells(a, "C")) = 1 Then
kral.Cells(c, "A") = asi.Cells(a, "C")
kral.Cells(c, "B") = asi.Cells(a, "D")
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("H:H"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("J:J"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("L:L"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("N:N"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("P:P"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("R:R"))
d = d + WorksheetFunction.SumIf(asi.Range("C:C"), asi.Cells( _
a, "C"), asi.Range("T:T"))
kral.Cells(c, "F") = d
c = c + 1: End If: Next
MsgBox "Değerleri Topladım", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte