Yavaş Çalışan Hesaplama Makrosu

[1Al2Ver]

Merhaba,

Aşağıdaki kod çalıştırıldığında, yaklaşık 20-25 saniye sonra ilk verisini "B17:G17" aralığına yazıyor,

Eğer bu esnada ESC tuşuna basarsam, tablonun hesaplamasını 1 dakika 30 saniye gibi bir sürede,

Eğer ESC tuşuna basmaz isem 5 dakika 40 saniye gibi bir sürede, hesaplıyor,

Kodu hızlandıracak olası çözümleri rica ediyorum,

Teşekkür ederim.

Sub RAPOR_OLUŞTUR()
On Error Resume Next
Set ra = Sheets("RAPOR"): Set RE = Sheets("REÇETE")
If ra.[C60].End(3).Row > 17 Then ra.Range("A17:G" & ra.[C59].End(3).Row).ClearContents
        
Cells.NumberFormat = General

    Select Case ra.[T2] 
        Case Is = "D….": hedef = 5
        Case Is = "O….": hedef = 6
        Case Is = "Y…..": hedef = 7
    End Select
    
For Yemek = 3 To ra.[F16].End(3).Row
Cells(ra.[C60].End(3).Row + 1, 2) = ra.Cells(Yemek, 6)
    ilk = WorksheetFunction.Match(ra.Cells(Yemek, 6), RE.Range("B:B"), 0)
    Son = WorksheetFunction.CountIf(RE.Range("B:B"), ra.Cells(Yemek, 6)) + ilk - 1
    For resat = ilk To Son
        rasat = ra.[C60].End(3).Row + 1: ra.Cells(rasat, 3) = RE.Cells(resat, 3)
        ra.Cells(rasat, 4) = RE.Cells(resat, 4): ra.Cells(rasat, 5) = RE.Cells(resat, hedef)
 
  ra.Cells(rasat, 5).NumberFormat = RE.Cells(resat, hedef).NumberFormat
 
        If Cells(rasat, 4) = "Gr" Then
            Cells(rasat, 4).Value = "Kg"
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5) / 1000

        Else
            ra.Cells(rasat, 6) = ra.[D14] * ra.Cells(rasat, 5)

        End If

        ra.Cells(rasat, 7) = RE.Cells(resat, hedef + 6)
    Next
Next
With ra.Range("A17:A" & ra.[C60].End(3).Row)
    .Formula = "=IF(ISERROR(MATCH(B17,$F$1:$F$15,0)),"""",MAX($A$16:A16)+1)": .Value = .Value
End With

ra.[G1].NumberFormat = "dd/mm/yyyy"
ra.[G19:G59].NumberFormat = "#.00"
End Sub

 

[ÖmerBey]

Merhaba,
Kodlarınızın başına ve sonuna aşağıdaki eklemeleri yapıp deneyiniz.

Sub RAPOR_OLUŞTUR()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
.
.
.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

 

[1Al2Ver]

Sayın ÖmerBey, merhaba,

Önerilen ekleme ile saniyeler içinde sonuç aldım,

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

Ne kadar teşekkür etsem, memnuniyetimi ifade etmiş olamam,

Teşekkür ederim.

Saygılarımla.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...

 

[volkan5454]

Merhaba,
Kodlarınızın başına ve sonuna aşağıdaki eklemeleri yapıp deneyiniz.

Sub RAPOR_OLUŞTUR()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
.
.
.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Hocam bende tesadüfen gördüm, böyle bir sorunum vardı denedim yarı yarıya hızlandırdı makromu teşekkür ederim.