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

问题描述 投票：0回答：2

我已经编写了这个项目，其中最后一步是循环遍历此工作簿中的工作表，并查找特定值并将其替换为输入值。但是，当有第二个工作簿打开时，这需要 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
2个回答
0
投票
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
0
投票

我知道我迟到了，但我想我会分享给其他有同样问题的人。我遇到了类似的问题，在打开另一个工作簿时查找/替换花费了更长的时间，并设法通过从其他工作簿中删除一些图形和数据表来修复它。我通过一次删除一张工作表并重新测试查找和替换来找到它们。不知道为什么他们会放慢这个过程，但尝试一下。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.