Sub GMC()
strike = 100
cap = 120
part = 3.25
KO = 60
For i = 1 To 1000
exp(i) = Worksheets("Speeder premium").Cells(i + 1, 32)
If exp(i) >= cap Then
cash = strike + (part * (cap - strike))
ElseIf exp(i) >= strike And exp(i) < cap Then
cash = strike + (part * (exp(i) - strike))
ElseIf exp(i) < strike And exp(i) >= KO Then
cash = strike
ElseIf exp(i) < strike And exp(i) < KO Then
cash = exp(i)
End If
Worksheets("Speeder premium").Cells(i + 1, 33) = cash
Next i
End Sub
So right now I'm repeating the below code for 1000 repetitions but ideally would like to do so for 10,000. I tried doing this with 10,000 and it is very slow and takes too long to process. How do I make the code faster and more efficient?
Option Explicit这将迫使您声明所有变量，其中包括其他变量，这将使代码更具可读性，意外行为（错误）更容易追踪......这是一个多一点的工作，但从长远来看，它会一定会有回报。快速修复
Sub GMC()
' Worksheet
wsName = "Speeder premium"
fRow = 2
rCount = 10000
sCol = 32
dCol = 33
' Data
Strike = 100
cap = 120
part = 3.25
KO = 60
' Define workbook.
Set wb = ThisWorkbook
' Define Source Range.
Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
' Write values from Source Range to Source Array.
Source = rng.Value
' Define Destination Array.
ReDim Dest(1 To rCount, 1 To 1)
' Loop through rows of Source Array, do the calculation,
' and write the results to Destination Array.
For i = 1 To rCount
Curr = Source(i, 1)
If Curr >= cap Then
cash = Strike + (part * (cap - Strike))
ElseIf Curr >= Strike And Curr < cap Then
cash = Strike + (part * (Curr - Strike))
ElseIf Curr < Strike And Curr >= KO Then
cash = Strike
ElseIf Curr < Strike And Curr < KO Then
cash = Curr
End If
Dest(i, 1) = cash
Next i
' Write values from Destination Array to Destination Range.
rng.Offset(, dCol - sCol).Value = Dest
End Sub
选项显式版本
Option Explicit
Sub GMC2()
' Worksheet
Const wsName As String = "Speeder premium"
Const fRow As Long = 2
Const rCount As Long = 10000
Const sCol As Long = 32
Const dCol As Long = 33
' Source
Const Strike As Long = 100
Const Cap As Long = 120
Const Part As Double = 3.25
Const KO As Long = 60
' Define Source Range.
Dim wb As Workbook
Set wb = ThisWorkbook
Dim rng As Range
Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
' Write values from Source Range to Source Array.
Dim Source As Variant
Source = rng.Value
' Define Target Array.
Dim Dest As Variant
ReDim Dest(1 To rCount, 1 To 1)
' Loop through rows of Source Array, do the calculation, and write
' the results to Destination Array.
Dim Curr As Variant
Dim i As Long
Dim Cash As Double
For i = 1 To rCount
Curr = Source(i, 1)
If Curr >= Cap Then
Cash = Strike + (Part * (Cap - Strike))
ElseIf Curr >= Strike And Curr < Cap Then
Cash = Strike + (Part * (Curr - Strike))
ElseIf Curr < Strike And Curr >= KO Then
Cash = Strike
ElseIf Curr < Strike And Curr < KO Then
Cash = Curr
End If
Dest(i, 1) = Cash
Next i
' Write values from Destination Array to Destination Range.
rng.Offset(, dCol - sCol).Value = Dest
End Sub
开头带有变量声明的选项显式版本
Sub GMC3()
' Worksheet
Const wsName As String = "Speeder premium"
Const fRow As Long = 2
Const rCount As Long = 10000
Const sCol As Long = 32
Const dCol As Long = 33
' Source
Const Strike As Long = 100
Const Cap As Long = 120
Const Part As Double = 3.25
Const KO As Long = 60
' Variables
Dim wb As Workbook
Dim rng As Range
Dim Source As Variant
Dim Dest As Variant
Dim Curr As Variant
Dim i As Long
Dim Cash As Double
' Define Source Range.
Set wb = ThisWorkbook
Set rng = wb.Worksheets(wsName).Cells(fRow, sCol).Resize(rCount)
' Write values from Source Range to Source Array.
Source = rng.Value
' Define Target Array.
ReDim Dest(1 To rCount, 1 To 1)
' Loop through rows of Source Array, do the calculation, and write
' the results to Destination Array.
For i = 1 To rCount
Curr = Source(i, 1)
If Curr >= Cap Then
Cash = Strike + (Part * (Cap - Strike))
ElseIf Curr >= Strike And Curr < Cap Then
Cash = Strike + (Part * (Curr - Strike))
ElseIf Curr < Strike And Curr >= KO Then
Cash = Strike
ElseIf Curr < Strike And Curr < KO Then
Cash = Curr
End If
Dest(i, 1) = Cash
Next i
' Write values from Destination Array to Destination Range.
rng.Offset(, dCol - sCol).Value = Dest
End Sub
编辑
测试
Option Explicit
Sub SpeedTest()
Const Reps As Long = 1000000
Dim Data As Variant
ReDim Data(1 To Reps, 1 To 1)
Dim Data2 As Variant
ReDim Data2(1 To Reps, 1 To 1)
Dim t As Double
t = Timer
With Sheet1.Cells(1, 1).Resize(Reps)
.Value = Empty
'.Value = 20000
'.Value = "This is a test."
' This one might take a while (15-20s)(uncomment all four lines):
' .Offset(, 1).Formula = "=RANDBETWEEN(1,5000)"
' .Offset(, 1).Value = .Offset(, 1).Value
' .Formula = "=IF(B1>2500,B1,A1)"
' .Value = .Value
End With
t = Timer - t
Debug.Print "It took " & t _
& " seconds to write the data to the worksheet."
t = Timer
Dim n As Long
For n = 1 To Reps
Data(n, 1) = Sheet1.Cells(n, 1).Value
Next n
t = Timer - t
Debug.Print "It took " & t _
& " seconds to access the worksheet " & Reps _
& " times to read one cell value."
Erase Data
t = Timer
Data2 = Sheet1.Cells(1, 1).Resize(Reps).Value
t = Timer - t
Debug.Print "It took " & t _
& " seconds to access the worksheet once to read " & Reps _
& " values."
Erase Data2
End Sub