与工作簿完成相关的用户窗体 VBA 进度条

Question

我有一个非常大的电子表格，目前有 129 个标签。简而言之，下面的宏消除了每个工作表的所有数组公式错误（#NUM）。这大约需要 15-20 分钟，但我想知道宏距离完成有多近。

我设计了一个没有问题的用户窗体进度条，并且我的代码正确引用了宏。除了更新用户窗体中的实际标签的部分外，一切正常。如何添加代码来定义宏的完成百分比是多少？我假设我需要使用“当前已完成的工作表/总工作表”，但我对 Userforms 非常陌生。

Sub DelNUM()
  Dim LR As Long
  Dim i As Long
  Dim sh As Worksheet

  For Each sh In Worksheets
    LR = sh.Range("B" & sh.Rows.Count).End(xlUp).Row
    For i = LR To 1 Step -1
        If IsError(sh.Range("B" & i)) Then sh.Rows(i).Delete
    Next i
  Next
End Sub

我已经查看了以下链接，但它适用于比我更有经验的人，所以我在关注它时遇到了麻烦：https://support.microsoft.com/en-us/help/211736/how-to-display-a-progress-bar-with-a-user-form-in-excel

我们将不胜感激。

谢谢，

肖恩

Answer 1

为了支持@BruceWayne 的评论，请尝试这种方法，看看您的运行时间是否显着减少：

此代码中用于节省时间的三个重要功能是：

1. 关闭计算（每行删除语句都会触发重新计算工作簿）
2. 使用 SpecialCells 一次性找到所有可能的错误单元格！
3. 每张纸删除行 1 次。每个删除调用都会占用处理时间。

代码如下：

Option Explicit

Sub DelNUM()

    Dim LR As Long
    Dim i As Long
    Dim sh As Worksheet

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

    For Each sh In Worksheets

        With sh

            LR = .Range("B" & sh.Rows.Count).End(xlUp).Row

            Dim formulaErrors As Range
            On Error Resume Next 'bc there may not be any error cells
            Set formulaErrors = .Range("B1:B" & LR).SpecialCells(xlCellTypeFormulas, xlErrors)
            On Error GoTo 0 'turn error catch back on

            If Not formulaErrors Is Nothing Then

                formulaErrors.EntireRow.Delete 'now we delete all error rows at once
                Set formulaErrors = Nothing 'reset for next loop

            End If

        End With

    Next

    Application.Calculation = xlCalculationAutomatic

End Sub

这样你可能不需要进度条:)