• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

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
 
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.
 
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.
Geri
Üst