vba - 为什么这个简单的宏(隐藏行)会导致 Excel 变得无响应？

Question

作为最近交通科学项目的一部分，我收到了一张包含 7094 起车祸数据的表格。为了仅过滤掉相关数据——在本例中涉及行人、死亡或重伤的撞车事故——我尝试改编我在网上找到的一个宏。

这是我第一次涉足 VBA，虽然我有一些 C 和 Java 的本科经验(以防万一这以某种方式证明是相关的)。代码如下:

Sub HideRows()
BeginRow = 2
EndRow = 7095
ChkCol = 10

For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value > 0 Or Cells(RowCnt, ChkCol + 1).Value > 0 Or Cells(RowCnt, ChkCol + 2).Value > 0 Then
        Rows(RowCnt).EntireRow.Hidden = False
    Else
        Rows(RowCnt).EntireRow.Hidden = True
    End If
        Next RowCnt
End Sub

问题是它会导致 Excel 变得无响应。我可以看到宏正在执行预期的功能，但最后我无法保存或重新获得对程序的控制。

努力解决这个问题会浪费很多时间，而且我感觉这个问题(以及随后的修复)非常非常简单 - 希望如此。

任何建议将不胜感激。

Answer 1

除了添加 ScreenUpdating 和 EnableEvent bool 值之外，您还可以重构代码以仅执行一个隐藏/取消隐藏操作(在本例中为两个)，而不是执行它在每个循环迭代中，这会减慢速度。您也可以关闭计算(以防影响事情)。

Option Explicit

    Sub HideRows()

        Dim BeginRow As Integer, EndRow As Integer, ChkCol As Integer

        BeginRow = 2
        EndRow = 7095
        ChkCol = 10

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

        Application.Calculation xl

        Dim rHide As Range
        Dim rShow As Range


        For RowCnt = BeginRow To EndRow

            If Cells(RowCnt, ChkCol).Value > 0 Or Cells(RowCnt, ChkCol + 1).Value > 0 Or Cells(RowCnt, ChkCol + 2).Value > 0 Then

                If Not rHide Is Nothing Then
                    Set rHide = Cells(1, RowCnt)
                Else
                    Set rHide = Union(rHide, Cells(1, RowCnt))
                End If

            Else

                If Not rShow Is Nothing Then
                    Set rShow = Cells(1, RowCnt)
                Else
                    Set rShow = rShow(rHide, Cells(1, RowCnt))
                End If

            End If

        Next RowCnt

        'show / hide appropriate ranges
        rHide.EntireRow.Visible = False
        rShow.EntireRow.Visible = True

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

    End Sub