vba - Excel 宏运行缓慢，如何使其更快？

Question

Stackovwerflow 社区。

我确实相信这个问题在这里被问了 x1000 次，但我只是无法为我的慢宏找到解决方案。

如果输入了正确的密码，此宏用于取消隐藏工作表上的某些区域。取消隐藏的区域取决于单元格值。在 Sheet1 上，我有一个将某些单元格值与密码相关联的表格。

这是我使用的代码。

第一个。部分(从名为“通过”的用户窗体开始单击 OK 按钮)

Private Sub CommandButton1_Click()

Dim ws As Worksheet
   DoNotInclude = "PassDB"
        For Each ws In ActiveWorkbook.Worksheets
        If InStr(DoNotInclude, ws.Name) = 0 Then
              Application.ScreenUpdating = False
              Call Module1.Hide(ws)
              Application.ScreenUpdating = True
               End If
        Next ws
End Sub

第 2 部分。

Sub Hide(ws As Worksheet)

Application.Cursor = xlWait

Dim EntPass As String: EntPass = Pass.TextBox1.Value

If EntPass = Sheet1.Range("G1").Value Then  ' Master-Pass, opens all
Sheet1.Visible = xlSheetVisible
ws.Unprotect Password:="Test"
ws.Cells.EntireRow.Hidden = False
Pass.Hide

Else

Dim Last As Integer: Last = Sheet1.Range("A1000").End(xlUp).Row

Dim i As Integer

For i = 2 To Last

Dim region As String: region = Sheet1.Range("A" & i).Value
Dim pswd As String: pswd = Sheet1.Range("B" & i).Value

If EntPass = pswd Then

ws.Unprotect Password:="Test"
ws.Cells.EntireRow.Hidden = False

Dim b As Integer
Dim Last2 As Integer: Last2 = ws.Range("A1000").End(xlUp).Row

For b = 2 To Last2
ws.Unprotect Password:="Test"
If ws.Range("A" & b).Value <> region Then
   ws.Range("A" & b).EntireRow.Hidden = True
End If
If ws.Range("A" & b).Value = "HEADER" Then
   ws.Range("A" & b).EntireRow.Hidden = False
End If
ws.Protect Password:="Test"

Next b

End If

Next i

End If

Application.Cursor = xlDefault
Sheet2.Activate
Sheet2.Select

Pass.Hide

End Sub

如果我输入 master-pass 以访问每个隐藏区域，它的工作速度足够快，但如果我输入 cell.value 相关密码，宏将在每个工作表上取消隐藏所需区域大约需要 5-6 分钟。

如果有人能指出性能缓慢的原因并建议对代码进行更改，我将不胜感激。以防万一，为了您的方便，我在这里上传了我的 excel 文件。

http://www.datafilehost.com/d/d46e2817

Master-Pass是OPENALL，其他密码是“1”到“15”。

提前谢谢你和最好的问候。

Answer 1

尝试批处理您的更改:

Dim rngShow as Range, c as range

ws.Unprotect Password:="Test" 'move this outside your loop !

For b = 2 To Last2
    Set c = ws.Range("A" & b)

    If c.Value = "HEADER" Then 
        c.EntireRow.Hidden = False
    Else
        If c.Value <> region Then
            If rngShow is nothing then
                Set rngShow = c
            Else
                Set rngShow=application.union(c, rngShow)
            End If
        End If
    End If
Next b

If Not rngShow is Nothing Then rngShow.EntireRow.Hidden = False

ws.Protect Password:="Test" 'reprotect...