Question

我已经写了几个sub，然后从main sub调用。单个子程序运行得非常快，大多数是瞬时的（由于表中的大量数据，DoFind子程序需要几秒钟才能运行）但是当我运行主子程序时，它需要一分钟才能执行。为什么会出现这种情况的任何想法/提示？

注意，我对VBA没有太多经验（过去一周都学到了所有经验）。还有其他使用的宏，但是它们没有显示，因为即使测试子也需要大约1分钟

Sub DoFind()

    Dim i As Long

    i = 1

        Do While Sheets("Temp").Cells(i, "A").Value <> Empty

                Dim BearingArray(6) As String


                BearingArray(0) = Sheets("Temp").Cells(i, "A").Value
                BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
                BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
                BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
                BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
                BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
                BearingArray(6) = Sheets("Temp").Cells(i, "G").Value


                With Sheets("Calculations")
                    .Cells(17, "K").Value = BearingArray(0)
                    .Cells(19, "O").Value = BearingArray(1)
                    .Cells(20, "O").Value = BearingArray(2)
                    .Cells(23, "O").Value = BearingArray(3)
                    .Cells(22, "O").Value = BearingArray(4)
                    .Cells(26, "O").Value = BearingArray(5)
                    .Cells(17, "L").Value = BearingArray(6)
                End With

                i = i + 1

                    If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
        Exit Do
                    Else
                    End If
        Loop
                    If Sheets("Temp").Cells(i, "A").Value = Empty Then
                        MsgBox "No available bearing."


                    End If


End Sub

Sub Create_Sheet_Temp()

    ThisWorkbook.Sheets.Add
    ActiveSheet.Name = "Temp"

' This creates a new worksheet called "Temp"

End Sub

Sub Copy_Paste()

    Dim NewTable As ListObject
    Sheets("Calculations").Activate

    Set NewTable = Sheets("Calculations").ListObjects("Full_Bearings_List")

    NewTable.Range.SpecialCells(xlCellTypeVisible).Select
    NewTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
    Sheets("Temp").Range("A1").PasteSpecial xlPasteAll
    Application.CutCopyMode = False

        'This sub copies all visible cells from a filtered table and pastes them to the new sheet called "Temp"

End Sub

Sub test()
    Create_Sheet_Temp
    Copy_Paste
    DoFind

End Sub

Answer 1

您可以通过将工作表存储在变量中（在循环之前）来加速代码。

Dim TempWS as Worksheet
Dim CalcWS as Worksheet
set tempws= Sheets("Temp")
set CalcWS=Sheets("Calculations")

同样在循环外声明数组。此外，我建议使用数字列索引。

Sheets("Temp").Cells(i, "G").Value

要 TempWS.Cells（i，7）.Value

与Empty相比并不总是最佳选择，请尝试

... <> ""

编辑：对于Copy，请尝试使用Copy方法的destination参数。帮助示例：

Worksheets("Sheet1").Range("A1:D4").Copy _ 
    destination:=Worksheets("Sheet2").Range("E5")

VBA宏运行时间太长

1 个答案: