800.000 satır 26 sütun veri içeren excel'i hızlandırma

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,182
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Alternatif olarak dizi yöntemi ile hesaplama yaptırdım. Bende yaklaşık 30 saniyede işlemleri bitiriyor.

Kod: 
Option Explicit

Sub Hesapla()
    Dim S1 As Worksheet, Liste As Variant, X As Long, Son As Long, Zaman As Double
    Dim Block_Size_X As Double, Block_Size_Y As Double, Block_Size_Z As Double
    Dim XMin As Double, YMin As Double, ZMin As Double
    Dim Recovery As Double, Selling_Price As Double, Selling_Cost As Double
    Dim Processing_Cost As Double, Mining_Cost As Double, Concentrate_Grade As Double
    
    Zaman = Timer
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Set S1 = Sheets("Sayfa1")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    Liste = S1.Range("A20:V" & Son).Value
    
    Block_Size_X = 6
    Block_Size_Y = 6
    Block_Size_Z = 6
    
    XMin = S1.Range("F5")
    YMin = S1.Range("G5")
    ZMin = S1.Range("H5")
    
    Recovery = S1.Range("C5")
    Selling_Price = S1.Range("C6")
    Selling_Cost = S1.Range("C7")
    Processing_Cost = S1.Range("C8")
    Mining_Cost = S1.Range("C9")
    Concentrate_Grade = S1.Range("C11")
    
    ReDim Veri(1 To UBound(Liste), 1 To 22)
    
    For X = LBound(Liste) To UBound(Liste)
        Veri(X, 1) = Liste(X, 1)
        Veri(X, 2) = Liste(X, 2)
        Veri(X, 3) = Liste(X, 3)
        Veri(X, 20) = Block_Size_X
        Veri(X, 21) = Block_Size_Y
        Veri(X, 22) = Block_Size_Z
        Veri(X, 4) = (Liste(X, 1) + Veri(X, 20) - XMin) / Veri(X, 20)
        Veri(X, 5) = (Liste(X, 2) + Veri(X, 21) - YMin) / Veri(X, 21)
        Veri(X, 6) = (Liste(X, 3) + Veri(X, 22) - ZMin) / Veri(X, 22)
        Veri(X, 7) = 0
        Veri(X, 8) = (0.0004 * Liste(X, 7)) + (0.0108 * Liste(X, 7)) + 2.679
        Veri(X, 9) = (Liste(X, 11) * Recovery * (Selling_Price - Selling_Cost)) - (Liste(X, 19) * (Processing_Cost + Mining_Cost))
        Veri(X, 10) = -Liste(X, 19) * Mining_Cost
        Veri(X, 11) = Liste(X, 19) * Liste(X, 7) / 100
        Veri(X, 12) = Liste(X, 19) * Liste(X, 7) * Recovery / Concentrate_Grade
        Veri(X, 13) = Liste(X, 19) * Liste(X, 7) * Liste(X, 14) / Recovery / Concentrate_Grade
        Veri(X, 14) = 0
        Veri(X, 15) = Liste(X, 13) * (Selling_Price - Selling_Cost) - Liste(X, 19) * (Processing_Cost + Mining_Cost)
        Veri(X, 16) = -Liste(X, 19) * Mining_Cost
        Veri(X, 17) = Liste(X, 12) * (Selling_Price - Selling_Cost) - Liste(X, 19) * (Processing_Cost + Mining_Cost)
        Veri(X, 18) = -Liste(X, 19) * Mining_Cost
        Veri(X, 19) = Liste(X, 20) * Liste(X, 21) * Liste(X, 22) * Liste(X, 8)
    Next
    
    S1.Range("A20").Resize(UBound(Liste), 22) = Veri
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Z

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,125
Excel Vers. ve Dili
office2010
Merhaba,

Çeşitlilik olsun.

Kod: 
Sub test()
Dim sh1 As Worksheet
zz = TimeValue(Now)
Application.ScreenUpdating = 0
Dim H, S, L
Set sh1 = Sheets("Sayfa1")
Son = sh1.Cells(Rows.Count, 1).End(3).Row
tbl = sh1.Range("A20:AB" & Son).Value
    kmX = sh1.[F5]
    kmY = sh1.[G5]
    kmZ = sh1.[H5]
    des5 = sh1.[C5]
    des6 = sh1.[C6]
    des7 = sh1.[C7]
    des8 = sh1.[C8]
    des9 = sh1.[C9]
    des10 = sh1.[C10]
    des11 = sh1.[C11]
    sat = UBound(tbl)
    ReDim b(1 To sat, 1 To 16)
        For i = 1 To sat
            H = (0.0004 * tbl(i, 7) ^ 2) + (0.0108 * tbl(i, 7)) + 2.679
            S = tbl(i, 20) * tbl(i, 21) * tbl(i, 22) * H
            L = S * tbl(i, 7) * des5 / des11
            b(i, 1) = (tbl(i, 1) + (tbl(i, 20)) - kmX) / tbl(i, 20) '  IX
            b(i, 2) = (tbl(i, 2) + (tbl(i, 21)) - kmY) / tbl(i, 21) '  IY
            b(i, 3) = (tbl(i, 3) + (tbl(i, 22)) - kmZ) / tbl(i, 22) '  IZ
            b(i, 4) = CDbl(tbl(i, 7))  ' Grade
            b(i, 5) = H  '  Density
            b(i, 6) = ((S * tbl(i, 7) / 100) * des5 * (des6 - des7)) - (S * (des8 + des9))
            b(i, 7) = S * des9
            b(i, 8) = S * tbl(i, 7) / 100
            b(i, 9) = L
            b(i, 10) = S * tbl(i, 7) / des11
            b(i, 11) = tbl(i, 14)
            b(i, 12) = (S * tbl(i, 7) * tbl(i, 14) / des11) * (des6 - des7) - S * (des8 + des9)
            b(i, 13) = S * des9
            b(i, 14) = L * (des6 - des7) - S * (des8 + des9)
            b(i, 15) = S * des9
            b(i, 16) = S
        Next i
    sh1.[D20].Resize(sat, 16) = b
Application.ScreenUpdating = 1
Erase b
Erase tbl
MsgBox "işlem tamam." & vbLf & CDate(TimeValue(Now) - zz), vbInformation
End Sub
Not: Sonuçlar + ya da - olarak kontrol edilmedi.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,182
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sayfadaki hücre başvurularını da kod içine alınca süre oldukça kısaldı. 30 saniye gibi bir zamanda tüm sütunlar hesaplanıyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst