Question

Stackovwerflow社区。

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

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

这是我使用的代码。

第一。部分（从名为＆＃34的用户形式开始;传递＆＃34;单击确定按钮）

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，其他密码是＆＃34; 1＆＃34;到＆＃34; 15＆＃34;。

提前感谢您和最好的问候。

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

Excel宏工作缓慢，如何使其更快？

2 个答案: