为什么这个VBA代码运行时间太长？
为什么这个VBA代码运行时间太长？
提问于 2022-04-12 07:05:46
您好，各位社区成员！
这是一个与VBA代码优化相关的查询，我是个初学者，所以我在这方面没有多少经验。我目前正在处理一个用于构建仪表板的excel文件，它需要清理电子表格中的数据。因此，我编写了一个非常简单的VBA代码，它成功地工作，但它需要不寻常的时间来执行(40-45分钟)。我在互联网上对此进行了研究，但没有找到解决办法。如果有人能帮助我优化我创建的VBA代码(在下面发布)，我会非常高兴，希望它最多需要5到10分钟才能执行，甚至更快。如果给定的条件在列中的指定范围内匹配，则代码很简单，它将删除整个行。谢谢您的帮助，我将非常感谢，因为我是一个学生在这个项目的工作！
VBA代码：
Sub Dashboard()
Application.ScreenUpdating = False
Dim rng As Range, i As Integer
'Set range to evaluate
Set rng = Range("N8:N10000")
'Loop backwards through the rows in the range to evaluate
For i = rng.Rows.Count To 1 Step -1
'If cell i in the range contains "x", delete the entire row
If rng.Cells(i).Value = "John" Then rng.Cells(i).EntireRow.Delete
Next
'Delete name Tom
Set rng = Range("L8:L10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "TOM" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("L8:L10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("O8:O10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("Q8:Q10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Sara
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "SARA" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Ben
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "BEN" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Meredith
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "MEREDITH" Then rng.Cells(i).EntireRow.Delete
Next
'Delete April
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "APRIL" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Jason
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JASON" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Sana
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "SANA" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete June
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JUNE" Then rng.Cells(i).EntireRow.Delete
Next
'Delete October
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "OCTOBER" Then rng.Cells(i).EntireRow.Delete
Next
'Delete January
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JANUARY" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("AS8:AS10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub回答 3
Stack Overflow用户
回答已采纳
发布于 2022-04-12 07:32:04
将其简化为一个循环
Option Explicit
Public Sub Dashboard()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Loop backwards through the rows in the range to evaluate
Dim i As Long
For i = 10000 To 8 Step -1
If Cells(i, "N").Value = "John" Or _
Cells(i, "L").Value = "TOM" Or _
Cells(i, "L").Value = vbNullString Or _
Cells(i, "O").Value = vbNullString Or _
Cells(i, "Q").Value = vbNullString Or _
Cells(i, "R").Value = vbNullString Or _
Cells(i, "R").Value = "SARA" Or _
Cells(i, "R").Value = "BEN" Or _
Cells(i, "R").Value = "MEREDITH" Or _
Cells(i, "R").Value = "APRIL" Or _
Cells(i, "R").Value = "JASON" Or _
Cells(i, "R").Value = "SANA" Or _
Cells(i, "AJ").Value = vbNullString Or _
Cells(i, "AJ").Value = "JUNE" Or _
Cells(i, "AJ").Value = "OCTOBER" Or _
Cells(i, "AJ").Value = "JANUARY" Or _
Cells(i, "AS").Value = vbNullString Then
Rows(i).EntireRow.Delete
End If
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub或者更快:收集要删除变量中的所有行，并一次全部删除它们：
Option Explicit
Public Sub Dashboard()
Dim RowsToDelete As Range
'Loop backwards through the rows in the range to evaluate
Dim i As Long
For i = 10000 To 8 Step -1
If Cells(i, "N").Value = "John" Or _
Cells(i, "L").Value = "TOM" Or _
Cells(i, "L").Value = vbNullString Or _
Cells(i, "O").Value = vbNullString Or _
Cells(i, "Q").Value = vbNullString Or _
Cells(i, "R").Value = vbNullString Or _
Cells(i, "R").Value = "SARA" Or _
Cells(i, "R").Value = "BEN" Or _
Cells(i, "R").Value = "MEREDITH" Or _
Cells(i, "R").Value = "APRIL" Or _
Cells(i, "R").Value = "JASON" Or _
Cells(i, "R").Value = "SANA" Or _
Cells(i, "AJ").Value = vbNullString Or _
Cells(i, "AJ").Value = "JUNE" Or _
Cells(i, "AJ").Value = "OCTOBER" Or _
Cells(i, "AJ").Value = "JANUARY" Or _
Cells(i, "AS").Value = vbNullString Then
' collect rows we want to delete in RowsToDelete
If RowsToDelete Is Nothing Then
Set RowsToDelete = Rows(i).EntireRow
Else
Set RowsToDelete = Union(RowsToDelete, Rows(i).EntireRow)
End If
End If
Next
'delete all at once in the end
If Not RowsToDelete Is Nothing Then
RowsToDelete.Delete
End If
End SubStack Overflow用户
发布于 2022-04-12 07:55:16
请试试下一个代码。它是紧凑的，使用一个迭代，一个数组使代码更快，一个Union范围来保留要删除的行的单元格。这些代码将立即删除，在代码末尾：
Sub Dashboard()
Dim sh As Worksheet, rng As Range, arr, rngDel As Range, rngAdd As Range, i As Long
Set sh = ActiveSheet
arr = sh.Range("L1:AS1000").value 'place the range in an array for faster iteration
For i = 8 To UBound(arr)
If arr(i, 3) = "John" Or arr(i, 1) = "TOM" Or arr(i, 1) = "" _
Or arr(i, 4) = "" Or arr(i, 6) = "" Or arr(i, 7) = "" _
Or arr(i, 7) = "BEN" Or arr(i, 7) = "SARA" Or arr(i, 7) = "MEREDITH" _
Or arr(i, 7) = "APRIL" Or arr(i, 7) = "JASON" Or arr(i, 7) = "SANA" _
Or arr(i, 25) = "" Or arr(i, 25) = "JUNE" Or arr(i, 25) = "OCTOBER" _
Or arr(i, 25) = "JANUARY" Or arr(i, 34) = "" Then
If rngDel Is Nothing Then
Set rngDel = sh.Range("A" & i)
Else
Set rngDel = Union(rngDel, sh.Range("A" & i))
End If
End If
Next i
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End SubStack Overflow用户
发布于 2022-04-12 08:00:17
如果可以使用助手列，则可以同时删除所有行：
Sub Dashboard()
Application.ScreenUpdating = False
With Range("ZZ8:ZZ10000")
.Formula = "=IF(OR(L8=""TOM"",L8="""",O8="""",Q8="""",R8="""",R8=""SARA"",R8=""BEN"",R8=""MEREDITH"",R8=""APRIL"",R8=""JASON"",R8=""SANA"",AJ8=""""," & _
"AJ8=""JUNE"",AJ8=""OCTOBER"",AJ8=""JANUARY"",AS8=""""),""X"",1)"
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
.ClearContents
End Sub
End With
Application.ScreenUpdating = True
End Sub该代码使用一个助手列(在我的代码中是ZZ，但它可以在任何地方)，并键入一个IG公式(OR...all您的条件)。如果满足任何这些条件，则返回"X“those返回1(数值)。
公式将根据结果返回文本或数值。然后，您可以在该列中选择包含返回文本(我们的X值)的公式的 all 单元格，并一次删除所有这些行。
然后，代码清除公式，并保持一切干净。
这种方法的优点是根本不循环，而是一次删除所有目标行。但否定的是，如果条件经常变化，更新代码部分可能会很烦人。
资料来源：
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/71838431
复制相关文章
相似问题
腾讯云开发者
