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

时间:2017-12-27 19:30:31

标签: excel vba excel-vba

我有一个非常大的电子表格,目前有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

任何和所有帮助将不胜感激。

谢谢,

肖恩

1 个答案:

答案 0 :(得分:1)

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

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

  1. 关闭计算(每行删除语句将触发工作簿的重新计算)
  2. 使用SpecialCells一次性查找所有可能的错误单元格!
  3. 每张纸删除1次。每个删除调用都会占用处理时间。
  4. 以下代码:

    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
    

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