İki tarih arası toplam alma.

[Muhammet]

Merhabalar

Ektedeki dosyada kullanmış olduğum kodları daha hızlı bir şekilde kod hazırlama imkanımız varmı?

Satır sayısı:80.000

Dosya indirme linki

Sub Özet()
Dim S1 As Worksheet, S2 As Worksheet
Dim i As Long, son As Long, son1 As Long, sat As Long
Dim Sure As Double, Zaman As Double
Zaman = Timer
Set S2 = Sheets("özet rapor")
Set sc = Sheets("veri tabanı")

    With Application
       .ScreenUpdating = False
        
       .Calculation = xlCalculationManual
     .EnableEvents = False
    End With

son = sc.Cells(Rows.Count, "D").End(xlUp).Row

alan1 = "'veri tabanı'!" & Range("M2:M5000").Address      ' İLK TARİH
alan2 = "'veri tabanı'!" & Range("N2:N5000").Address      ' SON TARİH

alan3 = "'veri tabanı'!" & Range("G2:G5000").Address      ' STOK GRUBU
alan4 = "'veri tabanı'!" & Range("H2:H5000").Address      ' STOK GRUB ADI

alan5 = "'veri tabanı'!" & Range("P2:P5000").Address      ' DEVİR Miktarı
alan6 = "'veri tabanı'!" & Range("o2:o5000").Address      ' Devir Tutarı

alan7 = "'veri tabanı'!" & Range("r2:r5000").Address      'Alım Miktar
alan8 = "'veri tabanı'!" & Range("q2:q5000").Address      'Alım Tutarı

alan9 = "'veri tabanı'!" & Range("AB2:AB5000").Address    'Sayım Miktarı
alan10 = "'veri tabanı'!" & Range("AC2:AC5000").Address   'Sayım Tutarı

alan11 = "'veri tabanı'!" & Range("ad2:ad5000").Address   'Tüketim Miktarı
alan12 = "'veri tabanı'!" & Range("ae2:ae5000").Address   'Tüketim Tutarı

    Sheets("özet rapor").Select
 
    For i = 4 To Cells(Rows.Count, "B").End(xlUp).Row

     Cells(i, "C") = Evaluate("=SUMPRODUCT((" & alan3 & "=" & Cells(i, "A").Address _
    & ")*(" & alan4 & "=" & Cells(i, "B").Address _
    & ")*(" & alan1 & ">=Q1)*(" & alan2 & "<=Q2)*(" & alan5 & "))")
    
    
    Next i

    With Application
       .ScreenUpdating = True
       .Calculation = xlCalculationAutomatic
      .EnableEvents = True
    End With
 

    MsgBox "Raporlama işleminiz tamamlanmıştır. İşlem süresi ; " & Format(Timer - Zaman, "0.00")

End Sub

 

[Muhammet]

Altarnatif çözüm varmı_?