1. 首頁
  2. 問答
  3. 循環工作表需要更長時間才能打開其他工作簿

循環工作表需要更長時間才能打開其他工作簿

2017-07-21 66 views
1

我編寫了此項目，其中最後一步是循環查看此工作簿中的工作表，並查找並用輸入的值替換特定值。但是，當打開第二個工作簿時，需要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

來源

2017-07-21 sportscenter_aj

回答

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

來源

2017-07-22 06:44:10

+0

經歷的每一步，你是對的，但這似乎沒有跳到另一個工作簿來完成替換功能。所以這似乎不是問題。 我試過你的代碼，但問題仍然存在。在沒有打開其他工作簿的情況下運行它是立竿見影的，但只要另一個工作簿打開即可。運行需要一分多鐘。再一次通過它，我找不到其他工作簿中試圖替換的地方。 –

+0

這是你的完整碼？可能是問題在代碼中的其他地方。當其他工作簿打開時，嘗試找到它產生問題的地方。或者，如果沒有隱私問題，您可以共享完整的代碼。 –

+0

這不是完整的代碼，但完整的代碼會產生隱私問題。此代碼已關閉用戶窗體，並且此部分是導致此問題的原因。我已經嘗試了打開多個工作表的代碼的其他部分，除非包含這部分代碼，否則問題不存在。我爲什麼會發生這種事情而迷失了方向。我假設，因爲它必須決定每次循環重新啓動時要去哪個工作簿。儘管如此，我已經定義了它。 –

相關問題

 相關問題