在其他工作簿打开的情况下，循环工作表需要更长的时间

【问题标题】：Loop for Worksheets takes Longer with other Workbooks open在其他工作簿打开的情况下，循环工作表需要更长的时间
【发布时间】：2017-07-21 20:02:46
【问题描述】：

我已经对这个项目进行了编码，其中最后一步是循环浏览此工作簿中的工作表，并使用输入的值查找和替换特定值。但是，当有第二个工作簿打开时，这需要 1-2 分钟，但当它自己打开时，可能需要 2 秒（我没有计时，只是近似值）。我在 Excel 2013 上使用 VBA，我感觉它正在尝试遍历每个可用的工作表，即使在不同的工作簿中也是如此，但我不确定这是否属实。我已经隔离了这段代码的时间限制：

Sub ButtonRun()

Dim varResponse As Variant

varResponse = MsgBox("Are you sure you wish to continue?" & vbNewLine & vbNewLine & "This action cannot be undone.", vbYesNo, "Confirm")
If varResponse = vbNo Then Exit Sub

If BoxAAA.Value = "" Then
    MsgBox "Please fill in AAA"
    Exit Sub
End If

If BoxBBB.Value = "" Then
    MsgBox "Please fill in BBB"
    Exit Sub
End If

If BoxCCC.Value = "" Then
    MsgBox "Please fill in CCC"
    Exit Sub
End If

If BoxDDD.Value = "" Then
    MsgBox "Please fill in DDD"
    Exit Sub
End If

If BoxEEE.Value = "" Then
    MsgBox "Please fill in EEE"
    Exit Sub
End If

If BoxFFF.Value = "" Then
    MsgBox "Please fill in FFF"
    Exit Sub
End If

If BoxGGG.Value = "" Then
    MsgBox "Please fill in GGG"
    Exit Sub
End If

If CheckA.Value = False And CheckB.Value = False And CheckC.Value = False _
    And CheckD.Value = False And CheckE.Value = False And CheckF.Value = False _
    And CheckG.Value = False And CheckH.Value = False And CheckI.Value = False _
    And CheckJ.Value = False And CheckK.Value = False And CheckL.Value = False _
    And CheckM.Value = False And CheckN.Value = False And CheckO.Value = False _
    And CheckP.Value = False And CheckQ.Value = False And CheckR.Value = False _
    And CheckS.Value = False And CheckT.Value = False And CheckU.Value = False _
    And CheckV.Value = False And CheckW.Value = False And CheckX.Value = False _
    And CheckY.Value = False And CheckZ.Value = False And ChekcAA.Value = False _
    And CheckBB.Value = False And CheckCC.Value = False And CheckDD.Value = False Then
        MsgBox "Please select Checkboxes."
        Exit Sub
End If

Dim fname As String
Dim path As String

path = Application.ActiveWorkbook.path
fname = BoxHHH.Value & ", " & BoxAAA.Value

    ActiveWorkbook.SaveAs Filename:=path & "\Created\" & fname, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Dim wb As Workbook
Set wb = Workbooks(fname)

If CheckA.Value = True Then
    wb.Sheets("A1").Visible = True
    wb.Sheets("A2").Visible = True
    wb.Sheets("A3").Visible = True
    wb.Sheets("A4").Visible = True
End If

If CheckB.Value = True Then
    wb.Sheets("B1").Visible = True
    wb.Sheets("B2").Visible = True
    wb.Sheets("B3").Visible = True
    wb.Sheets("B4").Visible = True
End If

If CheckC.Value = True Then
    wb.Sheets("C1").Visible = True
    wb.Sheets("C2").Visible = True
    wb.Sheets("C3").Visible = True
    wb.Sheets("C4").Visible = True
End If

If CheckD.Value = True Then
    wb.Sheets("D1").Visible = True
    wb.Sheets("D2").Visible = True
    wb.Sheets("D3").Visible = True
    wb.Sheets("D4").Visible = True
End If

If CheckE.Value = True Then
    wb.Sheets("E1").Visible = True
    wb.Sheets("E2").Visible = True
    wb.Sheets("E3").Visible = True
    wb.Sheets("E4").Visible = True
End If

If CheckF.Value = True Then
    wb.Sheets("F1").Visible = True
    wb.Sheets("F2").Visible = True
    wb.Sheets("F3").Visible = True
    wb.Sheets("F4").Visible = True
End If

If CheckG.Value = True Then
    wb.Sheets("G1").Visible = True
    wb.Sheets("G2").Visible = True
    wb.Sheets("G3").Visible = True
    wb.Sheets("G4").Visible = True
End If

If CheckH.Value = True Then
    wb.Sheets("H1").Visible = True
    wb.Sheets("H2").Visible = True
    wb.Sheets("H3").Visible = True
    wb.Sheets("H4").Visible = True
End If

If CheckI.Value = True Then
    wb.Sheets("I1").Visible = True
    wb.Sheets("I2").Visible = True
    wb.Sheets("I3").Visible = True
    wb.Sheets("I4").Visible = True
End If

If CheckJ.Value = True Then
    wb.Sheets("J1").Visible = True
    wb.Sheets("J2").Visible = True
    wb.Sheets("J3").Visible = True
    wb.Sheets("J4").Visible = True
End If

If CheckK.Value = True Then
    wb.Sheets("K1").Visible = True
    wb.Sheets("K2").Visible = True
    wb.Sheets("K3").Visible = True
    wb.Sheets("K4").Visible = True
End If

If CheckL.Value = True Then
    wb.Sheets("L1").Visible = True
    wb.Sheets("L2").Visible = True
    wb.Sheets("L3").Visible = True
    wb.Sheets("L4").Visible = True
End If

If CheckM.Value = True Then
    wb.Sheets("M1").Visible = True
    wb.Sheets("M2").Visible = True
    wb.Sheets("M3").Visible = True
    wb.Sheets("M4").Visible = True
End If

If CheckN.Value = True Then
    wb.Sheets("N1").Visible = True
    wb.Sheets("N2").Visible = True
    wb.Sheets("N3").Visible = True
    wb.Sheets("N4").Visible = True
End If

If CheckO.Value = True Then
    wb.Sheets("O1").Visible = True
    wb.Sheets("O2").Visible = True
    wb.Sheets("O3").Visible = True
    wb.Sheets("O4").Visible = True
End If


If CheckP.Value = True Then
    wb.Sheets("P1").Visible = True
    wb.Sheets("P2").Visible = True
    wb.Sheets("P3").Visible = True
    wb.Sheets("P4").Visible = True
End If

If CheckQ.Value = True Then
    wb.Sheets("Q1").Visible = True
    wb.Sheets("Q2").Visible = True
    wb.Sheets("Q3").Visible = True
    wb.Sheets("Q4").Visible = True
End If

If CheckR.Value = True Then
    wb.Sheets("R1").Visible = True
    wb.Sheets("R2").Visible = True
    wb.Sheets("R3").Visible = True
    wb.Sheets("R4").Visible = True
End If

If CheckS.Value = True Then
    wb.Sheets("S1").Visible = True
    wb.Sheets("S2").Visible = True
    wb.Sheets("S3").Visible = True
    wb.Sheets("S4").Visible = True
End If

If CheckT.Value = True Then
    wb.Sheets("T1").Visible = True
    wb.Sheets("T2").Visible = True
    wb.Sheets("T3").Visible = True
    wb.Sheets("T4").Visible = True
End If

If CheckU.Value = True Then
    wb.Sheets("U1").Visible = True
    wb.Sheets("U2").Visible = True
    wb.Sheets("U3").Visible = True
    wb.Sheets("U4").Visible = True
End If

If CheckV.Value = True Then
    wb.Sheets("V1").Visible = True
    wb.Sheets("V2").Visible = True
    wb.Sheets("V3").Visible = True
    wb.Sheets("V4").Visible = True
End If

If CheckW.Value = True Then
    wb.Sheets("W1").Visible = True
    wb.Sheets("W2").Visible = True
    wb.Sheets("W3").Visible = True
    wb.Sheets("W4").Visible = True
End If

If CheckX.Value = True Then
    wb.Sheets("X1").Visible = True
    wb.Sheets("X2").Visible = True
    wb.Sheets("X3").Visible = True
    wb.Sheets("X4").Visible = True
End If

If CheckY.Value = True Then
    wb.Sheets("Y1").Visible = True
    wb.Sheets("Y2").Visible = True
    wb.Sheets("Y3").Visible = True
    wb.Sheets("Y4").Visible = True
End If

If CheckZ.Value = True Then
    wb.Sheets("Z1").Visible = True
    wb.Sheets("Z2").Visible = True
    wb.Sheets("Z3").Visible = True
    wb.Sheets("Z4").Visible = True
End If

If CheckAA.Value = True Then
    wb.Sheets("AA1").Visible = True
    wb.Sheets("AA2").Visible = True
    wb.Sheets("AA3").Visible = True
    wb.Sheets("AA4").Visible = True
End If

If CheckBB.Value = True Then
    wb.Sheets("BB1").Visible = True
    wb.Sheets("BB2").Visible = True
    wb.Sheets("BB3").Visible = True
    wb.Sheets("BB4").Visible = True
End If

If CheckCC.Value = True Then
    wb.Sheets("CC1").Visible = True
    wb.Sheets("CC2").Visible = True
    wb.Sheets("CC3").Visible = True
    wb.Sheets("CC4").Visible = True
End If

If CheckDD.Value = True Then
    wb.Sheets("DD1").Visible = True
    wb.Sheets("DD2").Visible = True
    wb.Sheets("DD3").Visible = True
    wb.Sheets("DD4").Visible = True
End If

Dim ws As Worksheet

For Each ws In wb.Worksheets
    If ws.Visible = xlSheetVisible Then
        ws.Cells.Replace What:="AAA", Replacement:=BoxAAA.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="BBB", Replacement:=BoxBBB.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="CCC", Replacement:=BoxCCC.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="DDD", Replacement:=BoxDDD.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="EEE", Replacement:=BoxEEE.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="FFF", Replacement:=BoxFFF.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="GGG", Replacement:=BoxGGG.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End If
    Next ws
UserFormDealerInfo.Hide

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Visible <> True Then
        ws.Delete
    End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.Save

End Sub

似乎导致时间限制的代码是：

For Each ws In wb.Worksheets
    If ws.Visible = xlSheetVisible Then
        ws.Cells.Replace What:="AAA", Replacement:=BoxAAA.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="BBB", Replacement:=BoxBBB.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="CCC", Replacement:=BoxCCC.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="DDD", Replacement:=BoxDDD.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="EEE", Replacement:=BoxEEE.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="FFF", Replacement:=BoxFFF.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="GGG", Replacement:=BoxGGG.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End If
    Next ws
UserFormDealerInfo.Hide

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
    If ws.Visible <> True Then
        ws.Delete
    End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True

【问题讨论】：

    标签： excel excel-2013 vba


    【解决方案1】： 
    If you have specified the Workbook name I dont think it will loop through other WB sheet. Try to debug the code see how it run. OR
Also you can use **'for next loop**' instead for each...

For r = 1 to activeworkbook.worksheets.count

 If worksheet(r).Visible = xlSheetVisible Then

  worksheets(r).Cells.Replace What:="AAA", Replacement:=BoxAAA.Value, LookAt _ :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False

End if

Next

Try this if it works.

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
I have modified your code a bit kindly check if it works.
Sub ButtonRun()

Dim varResponse As Variant

varResponse = MsgBox("Are you sure you wish to continue?" & vbNewLine & vbNewLine & "This action cannot be undone.", vbYesNo, "Confirm")
If varResponse = vbNo Then Exit Sub

If (BoxAAA.Value = "") And (BoxBBB.Value = "") And (BoxCCC.Value = "") And (BoxDDD.Value = "") And _
    (BoxEEE.Value = "") And (BoxFFF.Value = "") And (BoxGGG.Value = "") Then
    MsgBox "Please fill all required boxes to Procees", vbOKOnly + vbCritical, "Error"
    Exit Sub
End If

'you can put code here to loop through all checkboxes insetead of writing long code..I donw know
' u have created checkboxes in form or in worksheet..E.G.

'  Dim checkbxchk As Control
'
'  For Each checkbxchk In UserForm1.Controls
'    If checkbxchk.Name Like "Check*" Then
'      if checkbxchk.value = false then
'           MsgBox "Please select Checkboxes and try again."
 '               exit sub
'    End If
'  Next




If CheckA.Value = False And CheckB.Value = False And CheckC.Value = False _
    And CheckD.Value = False And CheckE.Value = False And CheckF.Value = False _
    And CheckG.Value = False And CheckH.Value = False And CheckI.Value = False _
    And CheckJ.Value = False And CheckK.Value = False And CheckL.Value = False _
    And CheckM.Value = False And CheckN.Value = False And CheckO.Value = False _
    And CheckP.Value = False And CheckQ.Value = False And CheckR.Value = False _
    And CheckS.Value = False And CheckT.Value = False And CheckU.Value = False _
    And CheckV.Value = False And CheckW.Value = False And CheckX.Value = False _
    And CheckY.Value = False And CheckZ.Value = False And ChekcAA.Value = False _
    And CheckBB.Value = False And CheckCC.Value = False And CheckDD.Value = False Then
        MsgBox "Please select Checkboxes."
        Exit Sub
End If

Dim fname As String
Dim path As String

path = Application.ActiveWorkbook.path
fname = BoxHHH.Value & ", " & BoxAAA.Value

    ActiveWorkbook.SaveAs Filename:=path & "\Created\" & fname, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Dim wb As Workbook
Set wb = Workbooks(fname)

'you already have validate that all checkboxes should be checked to run the code so no need to put condtion here
'to check if it is true or not
'use this code
For Each Sheet In wb.Sheets
        If Sheet.Name Like ("*1") Or (Sheet.Name = "*2") Or (Sheet.Name = "*3") Or (Sheet.Name = "*4") Then
            Sheet.Visible = True
           Else
           Sheet.Visible = False
        End If
Next

Dim ws As Worksheet

For Each ws In wb.Worksheets
    If ws.Visible = xlSheetVisible Then
        ws.Cells.Replace What:="AAA", Replacement:=BoxAAA.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="BBB", Replacement:=BoxBBB.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="CCC", Replacement:=BoxCCC.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="DDD", Replacement:=BoxDDD.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="EEE", Replacement:=BoxEEE.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="FFF", Replacement:=BoxFFF.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        ws.Cells.Replace What:="GGG", Replacement:=BoxGGG.Value, LookAt _
            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
    End If
    Next ws
UserFormDealerInfo.Hide

Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws1 In wb.Worksheets
    If ws1.Visible = False Then
        ws1.Delete
    End If
Next ws1
Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.Save

End Sub

    【讨论】：

    • 经过每一步，你是对的，这似乎根本没有跳转到其他工作簿来执行替换功能。所以这似乎不是问题。我在上面尝试了您的代码，但问题仍然存在。在没有打开其他工作簿的情况下运行它是立即的，但只要另一个工作簿打开。运行需要一分钟以上。再次单步执行它，我在另一个工作簿中找不到它尝试替换的位置。
    • 这是您的完整代码吗？可能问题出在代码中的其他地方。当其他工作簿打开时，尝试查找它在哪里产生问题。或者，如果没有隐私问题，您可以共享完整代码。
    • 这不是完整的代码，但完整的代码会产生隐私问题。此代码不在用户表单中，这部分是导致问题的原因。我已经尝试了打开多张工作表的代码的其他部分，除非包含这部分代码，否则问题不存在。我不知道为什么会发生这种情况。我假设是因为它必须决定每次循环重新启动时要转到哪个工作簿。尽管如此，我已经定义了它。
    • 不，如果您定义了一个 wb，它将不会在工作簿之外运行，现在我不在城里，明天会在一些帮助下恢复。工作簿中有多少个工作表？或者您能否仅在没有代码和用户表单的情况下共享虚拟工作簿，其中包含虚拟数据。
    • 所以我将分享完整的代码。现在在上面。就像我说的那样，循环是导致时间紧缩的原因（如您所见，代码中现在有第二个循环）我尝试颠倒循环的顺序，但当有超过打开一个工作簿。我已经用完整的代码编辑了原始问题。正如我所说，循环是导致问题的原因。工作簿本身有 121 张。另一个工作簿可以是空白的，只有 1 张或 12 张，根据所需的时间，这似乎并不重要。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-11-20
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多
    热门标签
    Java Python linux javascript Mysql C# Docker 算法 前端 SpringBoot Redis Vue spring 设计模式 .net core .net kubernetes c++ 数据库 数据结构 大数据 js 机器学习 微服务 Android Go 程序员 面试 JVM ASP.net core 云原生 人工智能 后端 PHP git CSS golang k8s Nginx Django mybatis 深度学习 多线程 React 架构 devops 爬虫 云计算 Spring Boot LeetCode