Question

我正在为我正在进行的项目制作2个竞争程序。它是一种变更管理跟踪工具。它使用application.undo函数。

我正在尝试编写第3个程序来进行更改，以便我可以获得有关哪个程序运行速度更快的数据，但application.undo不能与程序一起使用。

有关如何绕过这个或解决方法的任何想法？

Sub Counter()
     Dim i As Integer
     Worksheets("F&E List").Cells(6, 6).Value = 0
     For i = 1 To 5
         Worksheets("F&E List").Cells(6, 6).Value = i
         Application.Undo
     Next i
End Sub

这给了我运行时间1004“方法撤销对象'_Application失败”

我从一般程序中得到的错误与

相同

Answer 1

最终，我调整了代码以模拟两个程序中的撤消，以测试其余代码，而无需实际启动application.undo命令。我认为两个程序中的撤消时间都是相同的，所以它不会成为代码速度的一个因素（至少可以控制一个），但这样我仍然可以比较代码。

此子更新电子表格并记录每次迭代花费的时间，然后导出到另一个工作表，以便我可以在minitab中查看它

 Sub Counter()
     Dim i As Integer
     Dim j As Integer
     Dim Time_Arr As Variant
     Worksheets("F&E List").Cells(4, 6).Value = 0
     ReDim Time_Arr(0) As Variant

     For i = 1 To 1000
         Worksheets("F&E List").Cells(4, 6).Value = i
         ReDim Preserve Time_Arr(i) As Variant
         Time_Arr(i) = Timer()
     Next i

     For i = 2 To UBound(Time_Arr)
         Worksheets("Time_Stamp").Cells(i, 1).Value = i
         Worksheets("Time_Stamp").Cells(i, 2).Value = Time_Arr(i) - Time_Arr(i - 1)
     Next i
 End Sub

这是代码的主体，我没有包含子程序，我可以，如果有人想看看它们。请注意我是如何绕过application.undo并创建一个虚假的旧值。我现在的目标是调查每个步骤的时间以及如何进一步缩短处理时间以减少滞后，因为这是每天使用表格所需要的。

 Sub New_Process(Target As Range)

     Dim vStartTime As Variant
     Dim rng As Range
     Dim new_arr As Variant, old_arr As Variant, add_arr As Variant
     Dim add_val As String, r As Range
     Dim i As Integer, j As Integer

     On Error GoTo ErrHandler:

     Set rng = Intersect(Target, Range("FETable"))

     If rng Is Nothing Then
         Exit Sub
     End If

     Call Optimize_VBA

     new_arr = rng.Value
     add_val = rng.Address

     **'Application.Undo 'changed to a comment for testing purposes**

     **'old_arr = Range(add_val).Value**
     old_arr = -1

     Call Get_Add(add_arr, rng)

     Range(add_val).Value = new_arr

     If rng.Count = 1 Then

         If old_arr <> new_arr Then
             Call Check_Change(old_arr, new_arr, add_val)
         End If             
     Else
    For i = LBound(add_arr, 1) To UBound(add_arr, 1)
        For j = LBound(add_arr, 2) To UBound(add_arr, 2)
            If old_arr(i, j) <> new_arr(i, j) Then
                'Debug.Print i, j, add_arr(i, j), old_arr(i, j), new_arr(i, j)
                Call Check_Change(old_arr(i, j), new_arr(i, j), add_arr(i, j))
                 End If
             Next j
         Next i
     End If

     Call Return_Func

 ErrHandler:

     If Err.Number = 13 Then
         Call Return_Func
         Exit Sub
     End If
 End Sub

VBA测试另一个程序的速度

1 个答案: