Question

我有一个宏，用于隐藏与所选客户无关的行。但是，由于我的报告越来越大，宏观正在逐渐放缓。

我正在寻找一种方法来提高这个宏的速度，截至目前它运行超过4分钟。

以下是代码：

Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

LastRow = Cells(Cells.Rows.Count, "CP").End(xlUp).Row
On Error Resume Next
For Each c In Range("CP1:CP" & LastRow)
   If c.Value = 0 Then
        c.EntireRow.Hidden = True
    ElseIf c.Value > 0 Then
        c.EntireRow.Hidden = False
    End If
Next
On Error GoTo 0

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

正如@SJR所说 - 使用AutoFilter 如果要查看过滤器箭头，请将VisibleDropDown属性更改为TRUE。

Private Sub Worksheet_Calculate()

    Dim LastRow As Long

    LastRow = Cells(Cells.Rows.Count, "CP").End(xlUp).Row

    With ActiveSheet
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If

        .Range(.Cells(1, "CP"), .Cells(LastRow, "CP")).AutoFilter _
            Field:=1, _
            Criteria1:=">0", _
            Operator:=xlAnd, _
            VisibleDropDown:=False

    End With

End Sub

编辑：经过测试，它在93毫秒内过滤了139987行。

时间码：

Private Declare Function GetTickCount Lib "kernel32" () As Long

Public CodeTimer As Long

'^^^^^ Top of module ^^^^^^

Public Function StartTimer()
    CodeTimer = GetTickCount
End Function

Public Function StopTimer()
    Dim FinalTime As Long
    FinalTime = GetTickCount - CodeTimer
    MsgBox Format(Now(), "ddd dd-mmm-yy hh:mm:ss") & vbCr & vbCr & _
            Format((FinalTime / 1000) / 86400, "hh:mm:ss") & vbCr & _
            FinalTime & " ms.", vbOKOnly + vbInformation, _
        "Code Timer"
    CodeTimer = 0
End Function

只需在代码顶部添加StartTimer，在底部添加StopTimer。

Answer 2

根据其值隐藏和取消隐藏行并在_Calculation事件中实现它，这是一个奇怪的设计决策。但是，如果将所有必须隐藏的行组合到一个范围并将所有必须显示在另一个范围内的行组合在一起，有一种方法可以显着提高它：

Public Sub HideQuickly()    

    Dim wholeRangeV As Range, wholeRangeNV As Range, myCell As Range, lastRow As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False        
    lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row

    For Each myCell In Range("A1:A" & lastRow)            
        Select Case myCell
        Case Is > 0
            If wholeRangeV Is Nothing Then
                Set wholeRangeV = myCell
            Else
                Set wholeRangeV = Union(wholeRangeV, myCell)
            End If
        Case Is = 0
            If wholeRangeNV Is Nothing Then
                Set wholeRangeNV = myCell
            Else
                Set wholeRangeNV = Union(wholeRangeNV, myCell)
            End If
        End Select
    Next myCell

    If Not wholeRangeNV Is Nothing Then
        wholeRangeNV.EntireRow.Hidden = True
    End If        
    If Not wholeRangeV Is Nothing Then
        wholeRangeV.EntireRow.Hidden = False
    End If

    Application.EnableEvents = True
    Application.ScreenUpdating = True        
End Sub

如您所见，使用上面的代码，每种类型只执行一次隐藏/取消隐藏操作：

wholeRangeV.EntireRow.Hidden = False
wholeRangeNV.EntireRow.Hidden = True

关于在Excel中将计算设置为手动，这有时被认为是一种坏习惯，因此尽量避免使用。

Answer 3

如果您没有负值，但只有零或正数，请跳过ElseIf语句。如果有，请将If语句更改为If ... >=0 Then。

提高宏隐藏行的速度

3 个答案: