Formülleri macroya çevirebilmek

[serkan.sevinc]

Merhaba,
Ekteki dosyada Satış ve Satışiade sayfaları "O" sütunlarında formül bulunmaktadır.
Özel sayfası A22 ve aşağısındaki sütunlarda da formül bulunmaktadır.
Satış sayfasındaki veriler 300.000 satırı bulabilmektedir. Özet sayfası A21 hücresinde marka değiştirdiğim zaman aşağıya doğru satış sayfasından veri çekmektedir.
Verilerin çok fazla olması sebebiyle formül ile rapor çok yavaş çalışmaktadır.

Macro bilgim fazla olmaması sebebiyle bu raporumu macro ile nasıl yapabileceğim konusunda yardımcı olabilir misiniz?

 

[serkan.sevinc]

YARDIM EDERSENİZ SEVİNİRİM

 

[serkan.sevinc]

yardım edebilecek var mı acaba?

 

[Korhan Ayhan]

Merhaba,

Bu kadar büyük tablolarda formüllerle sonuç üretmek efektif değildir. Makro kullanmak daha uygundur.

Önceki açtığınız başlıkta önermiş olduğum yardımcı sütunları (satış-satışiade sayfalarındaki O sütunu) silebilirsiniz.

Aşağıdaki kod ile deneme yaparak işlem süresini bildirirseniz sevinirim.

Option Explicit

Sub Iade_Oran_Raporu()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Dizi_Satis As Object, Dizi_Iade As Object, X As Long, Say As Long
    Dim Veri As Variant, Son_Iade As Long, Son_Satis As Long
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    
    Set S1 = Sheets("Özet")
    Set S2 = Sheets("satış")
    Set S3 = Sheets("satışiade")
    Set Dizi_Satis = CreateObject("Scripting.Dictionary")
    Set Dizi_Iade = CreateObject("Scripting.Dictionary")
    
    S1.Range("A22:G" & S1.Rows.Count).ClearContents

    Son_Iade = S3.Cells(S3.Rows.Count, 1).End(3).Row
    
    If Son_Iade = 1 Then GoTo 10
    
    If Son_Iade = 2 Then Son_Iade = 3
    
    Veri = S3.Range("A2:N" & Son_Iade).Value
    
    ReDim Liste_Iade(1 To Son_Iade, 1 To 3)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 9) = S1.Range("A21") Then
            If Not Dizi_Iade.Exists(Veri(X, 3)) Then
                Say = Say + 1
                Dizi_Iade.Add Veri(X, 3), Say
                Liste_Iade(Say, 1) = Veri(X, 3)
                Liste_Iade(Say, 2) = Veri(X, 7)
                Liste_Iade(Say, 3) = Veri(X, 13)
            Else
                Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 2) = Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 2) + Veri(X, 7)
                Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 3) = Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 3) + Veri(X, 13)
            End If
        End If
    Next


10  Son_Satis = S2.Cells(S2.Rows.Count, 1).End(3).Row
    
    If Son_Satis = 1 Then
        Application.ScreenUpdating = 0
        Application.Calculation = -4135
        MsgBox "Rapor için işlem yapılacak veri bulunamadı!", vbCritical
        GoTo 20
        Exit Sub
    End If
    
    If Son_Satis = 2 Then Son_Satis = 3
    
    Veri = S2.Range("A2:N" & Son_Satis).Value
    Say = 0
    
    ReDim Liste_Satis(1 To Son_Satis, 1 To 5)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 9) = S1.Range("A21") Then
            If Not Dizi_Satis.Exists(Veri(X, 3)) Then
                Say = Say + 1
                Dizi_Satis.Add Veri(X, 3), Say
                Liste_Satis(Say, 1) = Veri(X, 3)
                Liste_Satis(Say, 2) = Veri(X, 8)
                Liste_Satis(Say, 3) = Veri(X, 11)
                If Dizi_Iade.Exists(Veri(X, 3)) Then Liste_Satis(Say, 4) = Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 2)
                If Dizi_Iade.Exists(Veri(X, 3)) Then Liste_Satis(Say, 5) = Liste_Iade(Dizi_Iade.Item(Veri(X, 3)), 3)
            Else
                Liste_Satis(Dizi_Satis(Veri(X, 3)), 2) = Liste_Satis(Dizi_Satis(Veri(X, 3)), 2) + Veri(X, 8)
                Liste_Satis(Dizi_Satis(Veri(X, 3)), 3) = Liste_Satis(Dizi_Satis(Veri(X, 3)), 3) + Veri(X, 11)
            End If
        End If
    Next

    If Say > 0 Then
        With S1
            .Range("A22").Resize(Say, 5) = Liste_Satis
            .Range("F22").Resize(Say).Formula = "=IFERROR(D22/B22,0)"
            .Range("F22").Resize(Say).Value = .Range("F22").Resize(Say).Value
            .Range("G22").Resize(Say).Formula = "=IFERROR(E22/C22,0)"
            .Range("G22").Resize(Say).Value = .Range("G22").Resize(Say).Value
            .Columns.AutoFit
        End With
        
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        
        MsgBox "İade oranı raporu hazırlanmıştır." & vbLf & vbLf & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        Application.Calculation = -4105
        Application.ScreenUpdating = 1
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If
        
20  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set Dizi_Satis = Nothing
    Set Dizi_Iade = Nothing
End Sub

 

[serkan.sevinc]

Çok teşekkür ederim. Emeğinize sağlık. Gayet hızlı

 

[Korhan Ayhan]

İşlem zaman olarak ne kadar sürdü?

 

[serkan.sevinc]

3 SANİYE

 

[Korhan Ayhan]

Kaç satırlık bir tabloda denediniz?

 

[serkan.sevinc]

Merhaba
250.000 satır

 

[Korhan Ayhan]