慢Excel VBA代码

我试图编写一个代码，它将查看从第4行到R2000的B2中的单元格，如果内容为零，则隐藏该行。 我的问题是，代码运行速度非常慢，经常停止响应。 如果你能帮助我，那是什么导致它运行缓慢，我可以自己修复它，但我不知道什么是更有效的方法。 正如你所看到的，我已经尝试过closures屏幕更新，但没有多大帮助。

代码如下

Sub HideRows() BeginRow = 4 EndRow = 2059 ChkCol = 2 Application.ScreenUpdating = False Rows("1:2059").EntireRow.Hidden = False For RowCnt = BeginRow To EndRow If Cells(RowCnt, ChkCol).Value = 0 Then Cells(RowCnt, ChkCol).EntireRow.Hidden = True End If Next RowCnt Application.ScreenUpdating = True End Sub 

Answer 1

你可以使用Autofilter？

---

 Option Explicit Public Sub HideRowsWhereColBis0() ActiveSheet.Range("B4:B2059").AutoFilter Field:=1, Criteria1:="<>0" End Sub 

---

Answer 2

尝试隐藏一切，而不是每次发现0

 Sub HideRows() Dim BeginRow As Long, EndRow As Long, ChkCol As Long Dim HideRng As Range BeginRow = 4 EndRow = 2059 ChkCol = 2 Application.ScreenUpdating = False Rows("1:2059").EntireRow.Hidden = False For rowcnt = BeginRow To EndRow If Cells(rowcnt, ChkCol).Value2 = 0 Then If HideRng Is Nothing Then Set HideRng = Cells(rowcnt, ChkCol) Else HideRng = Union(HideRng, Cells(rowcnt, ChkCol)) End If End If Next rowcnt If Not HideRng Is Nothing Then HideRng.EntireRow.Hidden = True Application.ScreenUpdating = True End Sub 

Answer 3

没有看到你的工作簿，很难知道肯定，但通常Excel隐藏行很慢。 在你的代码中，每一行都是隐藏的，所以这个潜在的1000多个单独的“隐藏这行”命令到Excel中。

隐藏“块”中的行要快得多。 这个macros（我之前写过，因为我正在处理同样的问题）这样做，所以它应该更快。 在你的情况下，你会这样称呼它：

 Call hideRows(ActiveSheet, 4, 2059, 0, 2, 2) 

还有一个倒置的设置，可以隐藏行， 除非第2列的值等于零。 你只需要在函数调用的最后添加“True”即可。

 Sub hideRows(ws As Worksheet, startRow As Long, endRow As Long, valCrit As Variant, Optional startCol As Long = 1, Optional endCol As Long = 1, Optional invert As Boolean = False) Dim loopCounter As Long Dim rowCounter As Long Dim colCounter As Long Dim endConsRow As Long Dim tempArr As Variant Dim toAdd As Long Dim toHide As String Dim sameVal As Boolean Dim consBool As Boolean Dim tempBool As Boolean Dim rowStr As String Dim goAhead As Boolean Dim i As Long If startRow > endRow Then toAdd = endRow - 1 Else toAdd = startRow - 1 End If tempArr = ws.Range(ws.Cells(startRow, startCol), ws.Cells(endRow, endCol)).Value ws.Rows(startRow & ":" & endRow).Hidden = False loopCounter = 1 For rowCounter = LBound(tempArr, 1) To UBound(tempArr, 1) For colCounter = LBound(tempArr, 2) To UBound(tempArr, 2) sameVal = False goAhead = False If IsNumeric(valCrit) Then If tempArr(rowCounter, colCounter) = valCrit Then sameVal = True End If Else If tempArr(rowCounter, colCounter) Like valCrit Then sameVal = True End If End If If sameVal Then If invert = True Then loopCounter = loopCounter + 1 Exit For End If goAhead = True ElseIf colCounter = UBound(tempArr, 2) Then If invert = False Then loopCounter = loopCounter + 1 Exit For End If goAhead = True End If If goAhead = True Then endConsRow = rowCounter consBool = True Do Until consBool = False tempBool = False For i = LBound(tempArr, 2) To UBound(tempArr, 2) sameVal = False If endConsRow = UBound(tempArr, 1) Then Exit For ElseIf IsNumeric(valCrit) Then If tempArr(endConsRow + 1, i) = valCrit Then sameVal = True End If Else If tempArr(endConsRow + 1, i) Like valCrit Then sameVal = True End If End If If sameVal Then If invert = False Then endConsRow = endConsRow + 1 tempBool = True End If Exit For ElseIf i = UBound(tempArr, 2) Then If invert = True Then endConsRow = endConsRow + 1 tempBool = True End If End If Next If tempBool = False Then consBool = False End If Loop rowStr = loopCounter + toAdd & ":" & endConsRow + toAdd If toHide = "" Then toHide = rowStr ElseIf Len(toHide & "," & rowStr) > 255 Then ws.Range(toHide).EntireRow.Hidden = True toHide = rowStr Else toHide = toHide & "," & rowStr End If loopCounter = loopCounter + 1 + (endConsRow - rowCounter) rowCounter = endConsRow Exit For End If Next Next If Not toHide = "" Then ws.Range(toHide).EntireRow.Hidden = True End If End Sub