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

Stackovwerflow社区

我相信这个问题在这里被问了x1000次，但我就是找不到解决慢宏的方法

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

这是我使用的代码

第一。部件从名为Pass OK按钮的userform开始单击

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文件上传到这里了

主密码为OPENALL，其他密码为1到15

---

提前向您表示感谢并致以最良好的问候。

尝试批量处理您的更改：

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

---

尝试批量处理您的更改：

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

---

您可能还希望切换Application.Calculation=xlCalculationManual和Application.Calculation=xlCalculationAutomatic

您也可以尝试移动应用程序。屏幕更新代码脱离循环，它将按照编写的每一页进行更新

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

---

您可能还希望切换Application.Calculation=xlCalculationManual和Application.Calculation=xlCalculationAutomatic

您也可以尝试移动应用程序。屏幕更新代码脱离循环，它将按照编写的每一页进行更新

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

---

Bmo，谢谢你的建议，我错过了那部分！结合Tim Williams建议的解决方案，效果非常好！Bmo，谢谢你的建议，我错过了那部分！结合Tim Williams建议的解决方案，效果非常好！蒂姆，谢谢你的代码！正如我所希望的，它现在工作得更快！蒂姆，谢谢你的代码！正如我所希望的，它现在工作得更快！