Excel sayfasında günlük toplam listeleme

[seddur]

Merhabalar.Ekli dosyada görüleceği üzere Anasayfadaki ödeme ve işlem tipine göre (J ve K sutunları) yapılan günlük satış tutarlarını ("G" sutunu) ilgili tarihe karşılık gelen toplamlarını Sayfa1 B ve I arası sutunlarda gün gün listelemek istiyorum.Tabloda Toplam sutununda ise nakit-visa-çek-senet-havale toplamlarının hepsinin toplamı yer alacak. Yardımcı olabilirseniz sevinirim.

 

[ÖmerFaruk]

İPTAL yazanları nasıl değerlendireceğiz?

 

[seddur]

Onları değerlendirme dışı bıraksak da olur.

 

[ÖmerFaruk]

Kodlar aşağıda, dosyanız ekte.
Kod içinde bazı açıklamalar var, okuyun lütfen.
Verileriniz içinde Tutar sütununda BOŞLUK karakterleri vardı. Bunları SIFIR olarak KOD içinde değiştirdim.
Anasayfa verilerinizi KOD içinde tarihe göre sıraladım.
İşlem süresi benim bilgisayarımda 4 saniye civarında sürdü.
Verilerinizin uzunluğuna göre değişkenlik arzedebilir.

Private Sub CommandButton2_Click()
    Dim i As Long, Alan As Range, Bul As Range, Zaman As Double
    Dim FirstDate As Date, LastDate As Date, Dict As Object, Liste
    
    Zaman = Timer
    Set Dict = CreateObject("Scripting.Dictionary")
    For i = 2 To 8
        Dict.Add Worksheets("Sayfa1").Range("A1").Offset(0, i - 1).Value, i
    Next i
    
    'Anasayfadaki verileriniz sırasız olabilir diye kodları hızlandırmak için tarihe göre sıraladım
    Set Alan = Worksheets("Anasayfa").Range("A2:M" & Worksheets("Anasayfa").Range("A" & Rows.Count).End(3).Row)
    Alan.Sort Key1:=Worksheets("Anasayfa").Range("C2")
    
    Range("A2:I" & Rows.Count).ClearContents
    FirstDate = CDate("01.01.2021")     'Başlangıç ve bitiş tarihlerini elle ayarlıyorsunuz diye böyle bıraktım
    LastDate = CDate("31.12.2032")
    ReDim Liste(1 To DateDiff("d", FirstDate, LastDate) + 1, 1 To 9)
    For i = 1 To UBound(Liste)
        Liste(i, 1) = DateAdd("d", i - 1, FirstDate)
        Set Bul = Alan.Find(Liste(i, 1))
        If Not Bul Is Nothing Then
            Do
                'Anasayfadaki TUTAR sütununda bazı hücrelerde sayılsal olmayan ifadeler vardı. Bunları tespit ederse SIFIR yazdırdım
                If Not IsNumeric(Bul.Offset(0, 4)) Then Bul.Offset(0, 4) = 0
                If Dict.Exists(Bul.Offset(0, 7).Value) Then
                    Liste(i, Dict(Bul.Offset(0, 7).Value)) = Liste(i, Dict(Bul.Offset(0, 7).Value)) + Bul.Offset(0, 4).Value
                    If Dict.Exists(Bul.Offset(0, 8).Value) Then Liste(i, Dict(Bul.Offset(0, 8).Value)) = Liste(i, Dict(Bul.Offset(0, 8).Value)) + Bul.Offset(0, 4).Value
                End If
                Set Bul = Bul.Offset(1, 0)
                
            Loop Until Bul <> Liste(i, 1)
            Liste(i, 9) = Liste(i, 7) + Liste(i, 8)
        End If
    Next i
    Worksheets("Sayfa1").Range("A2").Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
    Erase Liste: Set Dict = Nothing: Set Alan = Nothing: Set Bul = Nothing
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[seddur]

Tamamdır, çalışmanız için Teşekkür ederim.