vba 宏中是否有比这个 foreach 循环更快的选项?
Is there a faster option than this foreach loop in a vba macro?
我正在尝试创建一个宏来格式化我的库存表。我只需要显示最大 8 的值,然后显示超过 9 的任何值。我还需要去掉任何 0 或负数。
我需要 运行 在 C、D、E 和 F 列上循环 4 次,文件长约 15,000 行。该代码在我调试时可以正常工作,但如果它只是 运行 就使应用程序崩溃。我知道我不能循环那么多,但有没有其他方法可以做到?
Call SetStockLevels(range("C3:C" & lastRow))
Private Sub SetStockLevels(range As range)
For Each c In range
If c.Value < 1 Then
c.ClearContents
ElseIf c.Value > 8 Then
c.Value = "9+"
End If
Next
End Sub
我已经有了分别在宏的开头和结尾调用的这些函数。
Public Sub speedup()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub
Public Sub normal()
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
此方法将范围值存储在数组中并从中进行处理,这应该比逐个单元格循环快得多。
如果您在 C-F 列中的起始行和结束行相同,则可以传递整个范围并一起处理。
Option Explicit
Private Sub Test()
Dim lastRow As Long
lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
SetStockLevels Sheet1.Range("C3:F" & lastRow)
End Sub
Private Sub SetStockLevels(setRng As Range)
Dim tempArr As Variant
tempArr = setRng.Value
Dim i As Long
Dim j As Long
For j = LBound(tempArr, 2) To UBound(tempArr, 2)
For i = LBound(tempArr, 1) To UBound(tempArr, 1)
Select Case tempArr(i, j)
Case Is < 1: tempArr(i, j) = ""
Case Is > 8: tempArr(i, j) = "9+"
End Select
Next i
Next j
setRng.Value = tempArr
End Sub
试验正则表达式
我认为正则表达式替换会更快,但它花费的时间几乎相同...
Sub SetStockLevels()
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
StartTime = Timer
'________________Timer Start_______________
Dim myrng As Range, mystr As String, arr, col As Range
Dim lastRow As Long, i As Long
Dim regex As Object, mc As Object
Set regex = CreateObject("VBScript.regexp")
regex.ignorecase = False
regex.Global = True
lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
Set myrng = Sheet1.Range("C3:F" & lastRow)
For Each col In myrng.Columns
mystr = "," & Join(Application.Transpose( _
Application.Index(col.Value, 0, 1)), ",") & ","
regex.Pattern = "-\d*(\.?\d*)" 'for negative numbers including decimal
mystr = regex.Replace(mystr, "")
regex.Pattern = ",0," 'for zeros
mystr = regex.Replace(mystr, ",,")
'__________________________________________________________________
'for numbers with decimals skip below two regex replacements _
'and use the loop below. Not sure how to get regex match for decimals > 8
regex.Pattern = "[0-9]{2,}" 'for numbers greater than 9
mystr = regex.Replace(mystr, "9+")
regex.Pattern = ",9," 'for Nine (Single digit)
mystr = regex.Replace(mystr, ",9+,")
'__________________________________________________________________
arr = Split(Mid(mystr, 2, Len(mystr) - 2), ",")
' For i = 0 To UBound(arr)
' If arr(i) <> "" And arr(i) > 8 Then arr(i) = "9+"
' Next i
col.Value = Application.Transpose(arr)
Next col
'________________Timer End_______________
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
我正在尝试创建一个宏来格式化我的库存表。我只需要显示最大 8 的值,然后显示超过 9 的任何值。我还需要去掉任何 0 或负数。
我需要 运行 在 C、D、E 和 F 列上循环 4 次,文件长约 15,000 行。该代码在我调试时可以正常工作,但如果它只是 运行 就使应用程序崩溃。我知道我不能循环那么多,但有没有其他方法可以做到?
Call SetStockLevels(range("C3:C" & lastRow))
Private Sub SetStockLevels(range As range)
For Each c In range
If c.Value < 1 Then
c.ClearContents
ElseIf c.Value > 8 Then
c.Value = "9+"
End If
Next
End Sub
我已经有了分别在宏的开头和结尾调用的这些函数。
Public Sub speedup()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub
Public Sub normal()
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
此方法将范围值存储在数组中并从中进行处理,这应该比逐个单元格循环快得多。
如果您在 C-F 列中的起始行和结束行相同,则可以传递整个范围并一起处理。
Option Explicit
Private Sub Test()
Dim lastRow As Long
lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
SetStockLevels Sheet1.Range("C3:F" & lastRow)
End Sub
Private Sub SetStockLevels(setRng As Range)
Dim tempArr As Variant
tempArr = setRng.Value
Dim i As Long
Dim j As Long
For j = LBound(tempArr, 2) To UBound(tempArr, 2)
For i = LBound(tempArr, 1) To UBound(tempArr, 1)
Select Case tempArr(i, j)
Case Is < 1: tempArr(i, j) = ""
Case Is > 8: tempArr(i, j) = "9+"
End Select
Next i
Next j
setRng.Value = tempArr
End Sub
试验正则表达式
我认为正则表达式替换会更快,但它花费的时间几乎相同...
Sub SetStockLevels()
Dim StartTime As Double
Dim SecondsElapsed As Double
'Remember time when macro starts
StartTime = Timer
'________________Timer Start_______________
Dim myrng As Range, mystr As String, arr, col As Range
Dim lastRow As Long, i As Long
Dim regex As Object, mc As Object
Set regex = CreateObject("VBScript.regexp")
regex.ignorecase = False
regex.Global = True
lastRow = Sheet1.Range("C" & Sheet1.Rows.Count).End(xlUp).Row
Set myrng = Sheet1.Range("C3:F" & lastRow)
For Each col In myrng.Columns
mystr = "," & Join(Application.Transpose( _
Application.Index(col.Value, 0, 1)), ",") & ","
regex.Pattern = "-\d*(\.?\d*)" 'for negative numbers including decimal
mystr = regex.Replace(mystr, "")
regex.Pattern = ",0," 'for zeros
mystr = regex.Replace(mystr, ",,")
'__________________________________________________________________
'for numbers with decimals skip below two regex replacements _
'and use the loop below. Not sure how to get regex match for decimals > 8
regex.Pattern = "[0-9]{2,}" 'for numbers greater than 9
mystr = regex.Replace(mystr, "9+")
regex.Pattern = ",9," 'for Nine (Single digit)
mystr = regex.Replace(mystr, ",9+,")
'__________________________________________________________________
arr = Split(Mid(mystr, 2, Len(mystr) - 2), ",")
' For i = 0 To UBound(arr)
' If arr(i) <> "" And arr(i) > 8 Then arr(i) = "9+"
' Next i
col.Value = Application.Transpose(arr)
Next col
'________________Timer End_______________
'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub