excel raporda tarih aralılığında süzdürme

[galipkuvvet]

Merhaba,
Elimde ekteki gibi sql sorgularından oluşan bir raporlar bütün var.
Arzum oki özet sayfasında vereceğim tarih aralığında stok listesindeki stok isimleri aratıp a)toplam alış kgr (alış-iade) toplayıp karşılığındaki satıra yazdıracağız;
b)toplam alış tutarı (alış-iade) toplayıp ilgili stok adının ilgili satırına yazdıracağız;
c) Bu iki rakamın (Toplam satış tutarı / Toplam alış tutarı) bölümünden oluşacak Ağırlıklı ortalama birim fiyatı hesaplattıracağız;
Bu işlemin sonundada Tüm özet tabloyu En fazla satış miktarından En az satış miktarına doğru sıralattıracağız.

Ben bunları Topla.çarpım ile yapıyorum ama dosyayı açtığımda hesaplaması sıralaması bayağı bir zaman tutuyor.

Hatta mümkün olur ise sql sorgularını direk excelden yapabilsek ne güzel olur. Sql sorgu cümlelerinin üçünü ekledim.

Yardımlarınızı beklerim şimdiden teşekkürler...

 

[galipkuvvet]

Yardım edecek kimse yomku

 

[Vedat Özer]

Merhabalar,

Kodları boş bir modül oluşturup deneyin.

Rakamların doğruluğu kontrol edin.

   Sub Rapor_Test()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Sonsat As Long, X As Long, Say As Long
    Dim Veri As Variant, Liste As Variant, Kriter As String, Zaman As Double
    Zaman = Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Set S2 = Sheets("Sayfa1")
    S2.Range("A5:N65536").ClearContents
    Call hamalış
    Call hamiade
    Call rejalış
    Call akfilrejalış
    Son = S2.Cells(S2.Rows.Count, 10).End(3).Row
    Veri = S2.Range("j5:n" & Son).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To 4)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For X = 1 To UBound(Veri, 1)
            If Veri(X, 2) >= S2.Range("B1") And Veri(X, 2) <= S2.Range("B2") Then
                Kriter = Veri(X, 3)
                If Not IsEmpty(Kriter) Then
                    If Not .Exists(Kriter) Then
                        Say = Say + 1
                        .Add Kriter, Say
                        Liste(Say, 1) = Veri(X, 3)
                    End If
                     On Error Resume Next
                     Liste(.Item(Kriter), 2) = Liste(.Item(Kriter), 2) + Veri(X, 4)
                     Liste(.Item(Kriter), 3) = Liste(.Item(Kriter), 3) + Veri(X, 5)
                     Liste(.Item(Kriter), 4) = Veri(X, 5) / Veri(X, 4)
                     On Error GoTo 0
                End If
            End If
        Next
    End With
    If Say > 0 Then
    S2.Range("A5").Resize(Say, 4).Value = Liste
    End If
    S2.Range("J1:N65536").ClearContents
    Set S2 = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000") & " Saniye", vbInformation, "Bilgilendirme"
    End Sub
    Sub hamalış()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Sonsat As Long, X As Long, Say As Long
    Dim Veri As Variant, Liste As Variant, Kriter As String
    Set S1 = Sheets("hamalış")
    Set S2 = Sheets("Sayfa1")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:L" & Son).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For X = 1 To UBound(Veri, 1)
            If Veri(X, 1) >= S2.Range("B1") And Veri(X, 1) <= S2.Range("B2") Then
                Kriter = Veri(X, 3) & ":" & Year(Veri(X, 1)) & ":" & Month(Veri(X, 1))
                If Not IsEmpty(Kriter) Then
                    If Not .Exists(Kriter) Then
                        Say = Say + 1
                        .Add Kriter, Say
                        Liste(Say, 1) = "Hamalış"
                        Liste(Say, 2) = Veri(X, 1)
                        Liste(Say, 3) = Veri(X, 3)
                    End If
                     Liste(.Item(Kriter), 4) = Liste(.Item(Kriter), 4) + Veri(X, 9)
                     Liste(.Item(Kriter), 5) = Liste(.Item(Kriter), 5) + Veri(X, 11)
                End If
            End If
        Next
    End With
    If Say > 0 Then
    
    S2.Range("J5").Resize(Say, 5).Value = Liste
    End If
    Set S1 = Nothing: Set S2 = Nothing
    End Sub
  Sub hamiade()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Sonsat As Long, X As Long, Say As Long
    Dim Veri As Variant, Liste As Variant, Kriter As String
    Set S1 = Sheets("hamiade")
    Set S2 = Sheets("Sayfa1")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:L" & Son).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For X = 1 To UBound(Veri, 1)
            If Veri(X, 1) >= S2.Range("B1") And Veri(X, 1) <= S2.Range("B2") Then
                Kriter = Veri(X, 3) & ":" & Year(Veri(X, 1)) & ":" & Month(Veri(X, 1))
                If Not IsEmpty(Kriter) Then
                    If Not .Exists(Kriter) Then
                        Say = Say + 1
                        .Add Kriter, Say
                        Liste(Say, 1) = "Hamiade"
                        Liste(Say, 2) = Veri(X, 1)
                        Liste(Say, 3) = Veri(X, 3)
                    End If
                     Liste(.Item(Kriter), 4) = Liste(.Item(Kriter), 4) - Veri(X, 9)
                     Liste(.Item(Kriter), 5) = Liste(.Item(Kriter), 5) - Veri(X, 11)
                End If
            End If
        Next
    End With
    If Say > 0 Then
    Sonsat = S2.Cells(S2.Rows.Count, 10).End(3).Row
    S2.Range("j" & Sonsat + 1).Resize(Say, 5).Value = Liste
    End If
    Set S1 = Nothing: Set S2 = Nothing
    End Sub
 Sub rejalış()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Sonsat As Long, X As Long, Say As Long
    Dim Veri As Variant, Liste As Variant, Kriter As String
    Set S1 = Sheets("rejalış")
    Set S2 = Sheets("Sayfa1")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:L" & Son).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For X = 1 To UBound(Veri, 1)
            If Veri(X, 1) >= S2.Range("B1") And Veri(X, 1) <= S2.Range("B2") Then
                Kriter = Veri(X, 3) & ":" & Year(Veri(X, 1)) & ":" & Month(Veri(X, 1))
                If Not IsEmpty(Kriter) Then
                    If Not .Exists(Kriter) Then
                        Say = Say + 1
                        .Add Kriter, Say
                        Liste(Say, 1) = "Rejalış"
                        Liste(Say, 2) = Veri(X, 1)
                        Liste(Say, 3) = Veri(X, 3)
                    End If
                     Liste(.Item(Kriter), 4) = Liste(.Item(Kriter), 4) + Veri(X, 9)
                     Liste(.Item(Kriter), 5) = Liste(.Item(Kriter), 5) + Veri(X, 11)
                End If
            End If
        Next
    End With
    If Say > 0 Then
    Sonsat = S2.Cells(S2.Rows.Count, 10).End(3).Row
    S2.Range("j" & Sonsat + 1).Resize(Say, 5).Value = Liste
    End If
    Set S1 = Nothing: Set S2 = Nothing
    End Sub

 Sub akfilrejalış()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Sonsat As Long, X As Long, Say As Long
    Dim Veri As Variant, Liste As Variant, Kriter As String
    Set S1 = Sheets("akfilrejalış")
    Set S2 = Sheets("Sayfa1")
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:L" & Son).Value
    ReDim Liste(1 To UBound(Veri, 1), 1 To 5)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For X = 1 To UBound(Veri, 1)
            If Veri(X, 1) >= S2.Range("B1") And Veri(X, 1) <= S2.Range("B2") Then
                Kriter = Veri(X, 2) & ":" & Year(Veri(X, 1)) & ":" & Month(Veri(X, 1))
                If Not IsEmpty(Kriter) Then
                    If Not .Exists(Kriter) Then
                        Say = Say + 1
                        .Add Kriter, Say
                        Liste(Say, 1) = "Akfilrejalış"
                        Liste(Say, 2) = Veri(X, 1)
                        Liste(Say, 3) = Veri(X, 2)
                    End If
                     Liste(.Item(Kriter), 4) = Liste(.Item(Kriter), 4) + Veri(X, 6)
                     Liste(.Item(Kriter), 5) = Liste(.Item(Kriter), 5) + Veri(X, 8)
                End If
            End If
        Next
    End With
    If Say > 0 Then
    Sonsat = S2.Cells(S2.Rows.Count, 10).End(3).Row
    S2.Range("j" & Sonsat + 1).Resize(Say, 5).Value = Liste
    End If
    Set S1 = Nothing: Set S2 = Nothing
    End Sub