Userform VBA进度条与工作簿完成关联

Question

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

我设计了一个没有问题的Userform进度条，我有正确引用宏的代码。除了更新Userform中实际Label的部分外，一切正常。如何添加代码来定义完成宏的百分比？我假设我需要使用“当前工作表已完成/总工作表”，但我对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

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