Excel Macro工作緩慢，如何使其更快？

Question

Stackovwerflow社區。

我確實相信這里曾問過這個問題x1000次，但我只是無法為我的慢速宏找到解決方案。

如果輸入正確的密碼，此宏可用於取消隱藏工作表上的某些區域。 取消隱藏哪個區域取決於單元格值。 在Sheet1上，我有一個表，將某些單元格值與密碼相關聯。

這是我使用的代碼。

1號 零件（從名為“通過”的用戶窗體開始，單擊“確定”按鈕）

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

第二部分。

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...

Answer 2

您可能還需要切換Application.Calculation = xlCalculationManual和Application.Calculation = xlCalculationAutomatic

您也可以嘗試將Application.Screenupdating代碼移出循環，它將按照編寫的每個工作表進行更新。

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Application.ScreenUpdating = False ''<- Here
   DoNotInclude = "PassDB"
        For Each ws In ActiveWorkbook.Worksheets
        If InStr(DoNotInclude, ws.Name) = 0 Then

              Call Module1.Hide(ws)

               End If
        Next ws
Application.ScreenUpdating = True ''<- Here
End Sub