慢的Excel VBA代碼

Question

我試圖編寫一個代碼，該代碼將查看從第4行到R2000的B2中的單元格，如果內容為零，則隱藏該行。 我的問題是代碼運行速度非常慢，並且經常停止響應。 如果可以幫助我解決導致它運行緩慢的問題，我可能可以自己修復它，但是我不確定哪種方法更有效。 如您所見，我已經嘗試過關閉屏幕更新，但是並沒有太大幫助。

代碼如下

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

嘗試一次隱藏所有內容，而不是每次都找到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 2

沒有看到您的工作簿，這很難確定，但是通常Excel在隱藏行方面相當慢。 在您的代碼中，每一行一次被隱藏，因此潛在地有1000多個單獨的“隱藏此行”命令發送到Excel。

將行隱藏在“塊”中要快得多。 這個宏（我很久以前就寫過它，因為我當時正在處理相同的問題）可以做到這一點，所以它應該更快。 就您而言，您可以這樣稱呼它：

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

Answer 3

可以使用自動過濾器嗎？

---

Option Explicit

Public Sub HideRowsWhereColBis0()

    ActiveSheet.Range("B4:B2059").AutoFilter Field:=1, Criteria1:="<>0"

End Sub

---