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

时间：2017-07-21 20:02:46

标签： excel-vba excel-2013 vba excel

我编写了这个项目，其中最后一步是遍历此工作簿中的工作表，并使用输入值查找和替换特定值。然而，当有第二个工作簿打开时，这需要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

1 个答案:

答案 0 :(得分：0)

pop
相关问题
最新问题