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



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

最新更新