Makro Hızı

[1Al2Ver]

Merhaba,

Ek'li dosyamdaki "RAPOR" sayfası, açık ve makro içermeyen yada açık ve içeriği olmayan sayfalar varsa çok hızlı işlem yaparken,

Açık ve makrolu dosyalarda, dosya boyutuna bağlı olarak 40-90 saniye arasında hesaplama yapıyor,

Yaklaşık 10 gündür denemediğim yöntem kalmadı,

Userform2'yi kaldırdım, olmadı,

Hız için,

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

ve

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

kodlarının yerlerini değiştirip denedim, ancak sonuç alamadım,

Konuyla ilgili görüş-öneri ve çözümlerinizi rica ediyorum,

Teşekkür ederim.

 

[Zeki Gürsoy]

Ekli XLSM örnek, bilgisayarımda 0,17 sn. işlem yaptı.

.

 

[1Al2Ver]

Sayın Zeki Gürsoy merhaba,

İlginiz ve bilgi için teşekkür ederim,

Eklediğim dosya, bende, başka hiç bir dosya açık değilse, 1-2 sn.de işlem yapıyor,

Ancak, boyutu yüksek ve makro içeren bir dosya açıkken sıkıntı başlıyor,

Kısa tecrübemle bunu aşamadım,

Değerli üyelerimizden çözüm bekliyorum,

Tekrar teşekkür ederim,

Saygılarımla.

 

[Zeki Gürsoy]

... başka hiç bir dosya açık değilse, 1-2 sn.de işlem yapıyor,
Ancak, boyutu yüksek ve makro içeren bir dosya açıkken sıkıntı başlıyor...

Aynı anda açık olan diğer dosyanın boyutunu bilemiyoruz ama, çok fazla ön bellek (RAM) tükkettiği, bu nedenle makronun çalışma süresinin uzadığı anlaşılıyor. 32 bit uygulamalara tahsis edilen ön belleğin az olduğunu da hatırlatmak isterim.

.

 

[Seyit Tiken]

Komple sütun yerine belirli bir alanı belirtip deneyiniz.

 

[1Al2Ver]

Sayın Zeki Gürsoy, tekrar merhaba,

İlginiz ve bilgilendirmeler için teşekkür ederim,

Saygılarımla.

 

[1Al2Ver]

Sayın Seyit Tiken merhaba,

İlginiz için teşekkür ederim.

Aralığı B2.B3000 olarak ayarlamıştım, ancak veriler, "REÇETE"den "RAPOR"a hatalı geldi, bu nedenle o aralığı aynen korumuştum,

İfade ettiğim gibi, yaklaşık 10 gündür, bilebildiğim kadarıyla, denemediğim yöntem kalmadı,

Açıkçası sorun nasıl aşılır, bilemiyorum ve bu belirsizlik beni son derece rahatsız ediyor,

Umarım bir çözüm yolu bulunur,

Saygılarımla.

 

[Korhan Ayhan]

RAPOR sayfasında tablonuzda veriler hep 59. satıra kadar mı oluyor?

Ayrıca RAPOR sayfasında E ve H sütunları boş görünüyor. Asıl dosyanızda bu sütunlarda ne var?

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Öncelikle ilginiz için teşekkür ederim.

Evet, "RAPOR" sayfası 59. satıra kadar veri alıyor,

"E" ve "H" sütununun çalıştığı (W2) hücresine göre hesaplama yapan dosya ek'tedir,

Tekrar teşekkür ederim.

 

[Korhan Ayhan]

E sütunundaki "1 Kişi İçin" bilgisi nereden geliyor?

Dizi kodlaması önereceğim için bu soruları soruyorum.

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

E sütunundaki 1 kişi için veri, "RAPOR" sayfası "W2" hücresinde orta yazıyor ise ; "REÇETE" sayfası "F" sütunundan geliyor,

Ancak şöyle de bir durum var,

"RAPOR" sayfası "W2" hücresinde düşük yazıyor ise, hesaplama "REÇETE" E sütunundan,
"RAPOR" sayfası "W2" hücresinde orta yazıyor ise, hesaplama "REÇETE" F sütunundan,
"RAPOR" sayfası "W2" hücresinde yüksek yazıyor ise, hesaplama "REÇETE" G sütunundan, yapılıyor.

Teşekkür ederim.

 

[Korhan Ayhan]

Peki DEVREDEN GELİR FAZLASI bilgisi nereden geliyor?

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Bu bilgi elle giriliyor,

Makro "A17:G59" ve "I17:I59" arasını hesaplarsa makbule geçer,

"H17:H59" aralığını formülle hesaplıyorum,

İlginiz için teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

17. satır ve alt kısmı tamamen makro ile oluşturulmaktadır. Bu sebeple verilerinizi yedekledikten sonra deneyiniz.

Asıl dosyanızda deneyip performansını bildirirseniz sevinirim.

Option Explicit

Sub Rapor()
    Dim S1 As Worksheet, S2 As Worksheet, Kriter As Object, Zaman As Double
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim Aranan As String, Alan As Range, WF As WorksheetFunction
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Zaman = Timer
    
    Set S1 = Sheets("RAPOR")
    Set S2 = Sheets("REÇETE")
    Set Kriter = CreateObject("Scripting.Dictionary")
    Set WF = WorksheetFunction
    
    S1.Range("A17:I" & S1.Rows.Count).Clear
    S1.Cells.Font.Name = "Arial Tur"
    S1.Cells.Font.Size = 8
    
    Veri = S1.Range("H3:H14").Value
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            Kriter.Item(UCase(Replace(Replace(Veri(X, 1), "ı", "I"), "i", "İ"))) = 1
        End If
    Next
    
    Son = S2.Cells(S2.Rows.Count, 2).End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = S2.Range("A2:N" & Son).Value
    
    ReDim Liste(1 To IIf(Kriter.Count = 0, 1, Kriter.Count) * 50, 1 To 9)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Aranan = UCase(Replace(Replace(Veri(X, 2), "ı", "I"), "i", "İ"))
        If Kriter.Exists(Aranan) Then
            Say = Say + 1
            Liste(Say, 1) = WF.Match(Aranan, Kriter.Keys, 0)
            Liste(Say, 2) = Veri(X, 2)
            Liste(Say, 3) = Veri(X, 3)
            Liste(Say, 4) = Veri(X, 4)
            Select Case UCase(Replace(Replace(S1.Range("W2"), "ı", "I"), "i", "İ"))
                Case "DÜŞÜK": Liste(Say, 5) = Veri(X, 5)
                Case "ORTA": Liste(Say, 5) = Veri(X, 6)
                Case "YÜKSEK": Liste(Say, 5) = Veri(X, 7)
            End Select
            If Veri(X, 4) = "Gr" Then
                Liste(Say, 4) = "Kg"
                Liste(Say, 6) = S1.Range("D15") * Liste(Say, 5) / 1000
            Else
                Liste(Say, 6) = S1.Range("D15") * Liste(Say, 5)
            End If
            Liste(Say, 7) = Veri(X, 8)
            If Liste(Say, 3) <> "" Then Liste(Say, 8) = Liste(Say, 6) * Liste(Say, 7)
            Liste(Say, 9) = Veri(X, 11)
        End If
    Next
    
    If Say > 0 Then
        With S1.Range("A17").Resize(Say, 9)
            .Value = Liste
            .Sort .Cells(1, 1), xlAscending
            .Columns(1).Formula = "=IF(COUNTIF(B$17:B17,B17)=1,IF(ISNUMBER(MATCH(B17,$H$1:$H$14,0)),MAX(A$16:A16)+1,""""),"""")"
            .Columns(1).Value = .Columns(1).Value
            .Columns(8).Formula = "=IF(C17="""","""",F17*G17)"
            .Borders(xlInsideVertical).LineStyle = 1
            
            If Say > 1 Then
                For Each Alan In .Columns(1).SpecialCells(xlCellTypeConstants, 1)
                    Alan.Resize(, 9).Borders(xlEdgeTop).LineStyle = 1
                Next
                .Columns(1).SpecialCells(xlCellTypeBlanks).Offset(, 1).ClearContents
            End If
            
            .BorderAround 1
        End With
        
        S1.Range("D17").Offset(Say) = "RAPOR TOPLAMI"
        S1.Range("H17").Offset(Say).Formula = "=SUM(H17:H" & Say + 16 & ")"
        S1.Range("I17").Offset(Say).Formula = "=SUM(I17:I" & Say + 16 & ")"
        S1.Range("D17").Offset(Say).Font.Bold = True
        S1.Range("H17").Offset(Say).Resize(, 2).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 1) = "DEVREDEN GELİR FAZLASI"
        S1.Range("H17").Offset(Say + 1) = Empty
        S1.Range("H17").Offset(Say + 1).Font.ColorIndex = 3
        S1.Range("D17").Offset(Say + 1).Font.Bold = True
        S1.Range("H17").Offset(Say + 1).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 2) = "GÜNÜN YEMEK GİDERİ"
        S1.Range("H17").Offset(Say + 2).Formula = "=H" & Say + 17
        S1.Range("D17").Offset(Say + 2).Font.Bold = True
        S1.Range("H17").Offset(Say + 2).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 3) = "YEMEK MİKTARI (KİŞİ)"
        S1.Range("H17").Offset(Say + 3).Formula = "=D15"
        S1.Range("D17").Offset(Say + 3).Font.Bold = True
        S1.Range("H17").Offset(Say + 3).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 4) = "BİR YEMEĞİN MALOLUŞ FİYATI"
        S1.Range("H17").Offset(Say + 4).Formula = "=IF(H" & Say + 2 + 17 & "=0,0,H" & Say + 2 + 17 & "/H" & Say + 3 + 17 & ")"
        S1.Range("D17").Offset(Say + 4).Font.Bold = True
        S1.Range("H17").Offset(Say + 4).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 5) = "GÜNLÜK GELİR FAZLASI"
        S1.Range("H17").Offset(Say + 5).Formula = "=IF(F15>H" & Say + 17 & ",F15-H" & Say + 17 & ",0)"
        S1.Range("D17").Offset(Say + 5).Font.Bold = True
        S1.Range("H17").Offset(Say + 5).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 6) = "ZİYAN"
        S1.Range("H17").Offset(Say + 6).Formula = "=IF(F15<H" & Say + 17 & ",F15-H" & Say + 17 & ",0)"
        S1.Range("D17").Offset(Say + 6).Font.Bold = True
        S1.Range("H17").Offset(Say + 6).Font.Bold = True
        
        S1.Range("D17").Offset(Say + 7) = "YARINA DEVREDEN GELİR FAZLASI"
        S1.Range("H17").Offset(Say + 7).Formula = "=IF(H" & Say + 5 + 17 & ">0,H" & Say + 1 + 17 & "+H" & Say + 5 + 17 & ",H" & Say + 1 + 17 & "+H" & Say + 6 + 17 & ")"
        S1.Range("D17").Offset(Say + 7).Font.Bold = True
        S1.Range("H17").Offset(Say + 7).Font.Bold = True
        
        S1.Range("H1").NumberFormat = "dd/mm/yyyy"
        S1.Range("H17").Resize(Say + 8).NumberFormat = "#,##0.00"
        S1.Range("H17").Offset(Say + 3).NumberFormat = "#,##0"
        S1.Range("G17").Resize(Say).NumberFormat = "#,##0.0000"
        S1.Range("E3:F6,E8:F15").NumberFormat = "#.00"
        S1.Range("D17").Offset(Say).Resize(8, 4).Merge True
        S1.Range("D17").Offset(Say).Resize(, 6).Borders.LineStyle = 1
        S1.Range("D17").Offset(Say).Resize(8, 5).Borders.LineStyle = 1
        S1.Range("D17").Resize(Say, 2).HorizontalAlignment = xlCenter
    
        S1.Columns.AutoFit
        
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
    
        MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbInformation
    Else
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
        
        MsgBox "Uygun veri bulunamadı." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00"), vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set Kriter = Nothing
    Set WF = Nothing
End Sub

 

[1Al2Ver]

Sayın Korhan Ayhan tekrar merhaba,

Öncelikle tüm emeklerinize ve göstermiş olduğunuz ilgiye çok çok teşekkür ederim, sağ olun,

Siteye eklediğim dosya açıkken, 2.02 MB'lık dosyamda hesaplama süresi ; 14.86 saniye

2 adet, yaklaşık 2.02 MB dosya açıkken hesaplama süresi ; 35,12 saniye

Bir ricam olacak,

"RAPOR" sayfası "H17:H59" arasını formülle hesaplamak istiyorum,

Nedeni ; E-F ve G sütunlarında, bazen manuel düzeltmeler oluyor, bu durumda "H" sütununun (Maliyetin) değişmesi gerekiyor,

Ayrıca, hesaplama sırasında Excel Yanıt Vermiyor mesajı alıyorum.

Tekrar teşekkür ederim.

 

[Korhan Ayhan]

Koda küçük bir ekleme yaptım. Yeniden deneyiniz.

Excelin yanıt vermesi durumu kullandığınız formül yoğunluğundan olabilir.

Benim önerdiğim kod hücrelerle işlem yapmadığı için (biçimlendirmeler dışında) daha hızlı sonuç verecektir. İşlemler arka planda hafıza tarafında yapılmaktadır. Klasik döngü ile yapılan işlemle farkını büyük veri yığınlarında gözlemleyebilirsiniz.

 

[Korhan Ayhan]

Ek bilgi olarak işlemin tamamlanma hızı bilgisayarınızın ram ve işlemci performansı ile doğrudan orantılıdır.

Ben kendi bilgisayarımda (İ5 6. Nesil 8 GB Ram) ile foruma eklediğiniz dosyada yaklaşık 0,10 saniye civarında sonuçlar alıyorum.

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Gecenin bu saatlerinde, sabırla ürettiğiniz çözüm ve değerli açıklamalarınız için teşekkür ederim,

Beni çok büyük bir stresten kurtardınız, çok sağ olun.

Yazdığınız kod, kod olmaktan çıkmış adeta bir eser olmuş, isteklerimin dışında çizelgeye estetik kazandırmışsınız, çok harika görünüyor,

Teşekkür ve saygılarımla.

 

[Korhan Ayhan]

Bu arada E3 hücresindeki formülü de aşağıdaki gibi değiştirmeyi unutmayınız. Sonrasında aşağıya sürükleyiniz.

=DÜŞEYARA("BİR YEMEĞİN MALOLUŞ FİYATI";D:H;5;0)

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

Uyarınız için teşekkür ederim,

Saygılarımla.