VBA函数执行任务的速度非常慢



我在工作表中有很多数据,我一直在使用这些函数通过匹配条件来删除行,执行任务的速度非常慢。

我希望能得到一些帮助,使它更快。任何帮助都将不胜感激。

如果这可以转换成1个代码,这将是一个很大的帮助。

Sub MyList()

Dim Listing     As Worksheet
Dim LastRow     As Long

LastRow = Function1.GetLastFilledRowNo(Listing)

For RowNo = LastRow To 9 Step -1
SKU = Format(Listing.Cells(RowNo, 4), "0000000")

RowNoActive = Function2.GetRowNo_BySku(SKU)

If RowNoActive > 0 Then
Listing.Rows(RowNo).Delete
End If

Next RowNo
End Sub

Public Function GetLastFilledRowNo(Sht As Worksheet) As Long
GetLastFilledRowNo = Sht.Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
End Function

Public Function GetRowNo_BySku(FormattedSku As String) As Long
GetRowNo_BySku = Function3.GetRowNoSearchOneColumnByString( _
Sheet1, FormattedSku, 2)
End Function

Public Function GetRowNoSearchOneColumnByString(SheetName As String, StringToFind As String, ColumnName As String) As Long

On Error GoTo GetRowNoSearchOneColumnByString_Error

Dim StrFormula  As String
GetRowNoSearchOneColumnByString = WorksheetFunction.Match(StringToFind, ThisWorkbook.Worksheets(SheetName).Range(ColumnName & ":" & ColumnName), 0)

Exit Function

GetRowNoSearchOneColumnByString_Error:
GetRowNoSearchOneColumnByString = 0
End Function

好吧,你应该关闭计算和屏幕更新。如果这还不够,请确保使用Union()将所有要删除的行收集到一个变量中,并在最后一次删除它们(这将比单独删除每一行更快(。

Sub MyList()  
Dim Listing     As Worksheet
Dim LastRow     As Long

LastRow = Function1.GetLastFilledRowNo(Listing)
Dim RowsToDelete As Range  ' collect all rows
For RowNo = LastRow To 9 Step -1
SKU = Format(Listing.Cells(RowNo, 4), "0000000")

RowNoActive = Function2.GetRowNo_BySku(SKU)

If RowNoActive > 0 Then
' don't delete here just collect all rows to delete
If RowsToDelete Is Nothing Then
Set RowsToDelete = Listing.Rows(RowNo)
Else
Set RowsToDelete = Union(RowsToDelete, Listing.Rows(RowNo))
End If
End If
Next RowNo
' if there is something collected then delete 
If Not RowsToDelete Is Nothing Then
RowsToDelete.Delete
End If
End Sub

如果所有这些都不能显著加快速度,那么问题可能是在每一行上运行Match方法(这只需要花费大量时间,无法避免(。您可以测试将整个数据读取到数组中并在该数组上执行匹配是否会使其更快。但为此,您需要更改代码的整个设计。

最新更新