excel - 循环通过 10,000 个单元格时如何使 VBA 代码运行得更快?
问题描述
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
所以现在我将下面的代码重复 1000 次,但理想情况下希望这样做 10,000 次。我尝试使用 10,000 进行此操作,但速度非常慢并且处理时间太长。如何让代码更快更高效?
解决方案
使用数组
- 我鼓励您使用
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
推荐阅读
- javascript - 如何在 reactjs 中以编程方式触发引导模式
- r - R中两组数据的卡方检验
- yaml - Sphinx:有没有办法通过 sphinx 读取 yaml 文件并生成 HTML 页面?
- fragment - ListFragment 仅在带有 ExpandableListadpater 的片段视图中显示第一项
- python - 仅当整行(每列)具有 NaN 值时,将 pandas 中的行替换为下一行
- authentication - CakePHP4 - 身份验证 - 如何更改默认用户模型?
- c++ - 如何捕获 QTableWidget 的编辑单元格的按键事件?
- javascript - ArangoDB:发送“statusCode:0”
- java - 二维数组中的非重复数字
- node.js - “请求有未知参数:[选项]”