工作表行为非常缓慢，隐藏行

Question

由于某些原因，此宏表现出非常迟缓的宏运行。由于每次尝试更改不属于范围的未隐藏单元格的信息时，这会变得有问题，因此它仍会运行更新并需要将近5-10秒才能完成。

该公式需要发生什么变化才能解决这个问题？

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim c As Range 


    For Each c In Range("A7:A98") 
     If c.Value = 0 And c.Value = vbNullString Then 
     c.EntireRow.Hidden = True 
     End If 
    Next c 

    For Each c In Range("A7:A98") 
     If c.Value <> 0 And c.Value <> vbNullString Then 
     c.EntireRow.Hidden = False 
     End If 
    Next c 

End Sub 

Answer 1

你的逻辑似乎简略，这是一个有点分不清你正在尝试做的，但你的逻辑可以缩短，用来确定布尔值.Hidden。

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Not Intersect(Target, Range("A7:A98")) Is Nothing Then 
     On Error GoTo safe_exit 
     Application.EnableEvents = False 
     Dim trgt As Range 
     For Each trgt In Intersect(Target, Range("A7:A98")) 
      trgt.EntireRow.Hidden = CBool(trgt.Value = vbNullString) 
     Next trgt 
    End If 

safe_exit: 
    Application.EnableEvents = True 

End Sub 

Answer 2

像这样的东西应该为你工作：

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim rCheck As Range 
    Dim rCell As Range 
    Dim rHide As Range 
    Dim lCalc As XlCalculation 

    Set rCheck = Me.Range("A7:A98") 

    With Application 
     lCalc = .Calculation 
     .Calculation = xlCalculationManual 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    On Error GoTo CleanExit 

    If Not Intersect(Target, rCheck) Is Nothing Then 
     rCheck.EntireRow.Hidden = False 
     For Each rCell In rCheck 
      If rCell.Value = 0 And rCell.Value = vbNullString Then 
       If rHide Is Nothing Then 
        Set rHide = rCell 
       Else 
        Set rHide = Union(rHide, rCell) 
       End If 
      End If 
     Next rCell 
    End If 

    If Not rHide Is Nothing Then rHide.EntireRow.Hidden = True 

CleanExit: 
    With Application 
     .Calculation = lCalc 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 

End Sub