Question

我在一个工作表上有一组数据。我需要遍历数组，根据特定条件评估每一行，然后采用匹配行的条件并将它们复制到另一个工作表。我写了以下代码来完成这个过程。

然而，循环需要太长时间。运行大约需要5分钟。我需要它在不到30秒的时间内运行。我在SO上阅读了以下q：What is the most efficient/quickest way to loop through rows in VBA (excel)?并引导我创建数组。我还试图保持代码简单。我关闭了screenupdating并启用了事件。

我可以做些什么来加快这个过程？谢谢你的帮助。

Sub tester()

Dim vData() As Variant
Dim R As Long
Dim C As Long
Dim LastRow1 As Long
Dim rng1 As Range, rng2 As Range

Set sh3 = Sheets("ABC")
Set sh5 = Sheets("XYZ")

Application.ScreenUpdating = False
Application.EnableEvents = False

LastRow1 = sh3.Cells(Rows.Count, "A").End(xlUp).Row
vData = Range("A1:N" & LastRow1).Value

sh5.Range("B3:AV10000").ClearContents

For R = 1 To UBound(vData, 1)
    For C = 1 To UBound(vData, 2)
        If sh3.Cells(R, "G").Value <= Date Then 'if date is prior to today then
            If sh3.Cells(R, "J").Value = "C" Then
                If sh3.Cells(R, "D").Value > 0 Then
                    If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then
                        Set rng1 = sh3.Range("A" & R & ":N" & R)
                        Set rng2 = sh5.Range("B" & R & ":O" & R)
                        rng1.Copy rng2
                    Else
                        Set rng3 = sh3.Range("A" & R & ":N" & R)
                        Set rng4 = sh5.Range("B" & R & ":O" & R)
                        rng3.Copy rng4
                    End If
                ElseIf sh3.Cells(R, "D").Value < 0 Then
                    If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then
                        Set rng5 = sh3.Range("A" & R & ":N" & R)
                        Set rng6 = sh5.Range("B" & R & ":O" & R)
                        rng5.Copy rng6
                    Else
                        Set rng7 = sh3.Range("A" & R & ":N" & R)
                        Set rng8 = sh5.Range("B" & R & ":O" & R)
                        rng7.Copy rng8
                    End If
                End If
            End If
        End If
    Next C
Next R

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Answer 1

根据我的评论，请尝试使用Application.Calculation = xlCalculationManual和Application.DisplayAlerts = False加快速度。

请务必将Application.Calculation = xlCalculationAutomatic和Application.DisplayAlerts = True放在最后：）

Answer 2

此外 - 通过频繁回拨api，您失去了大量节省数组功能的时间。示例：

 if sh3.Cells(R, "G").Value

应与

相同

 if vData(R,7)

你可能不需要循环

 For C = 1 to ubound(vData,2)
 Next C

您不会在任何地方引用它，它会以指数方式增加指令数量。

尝试使用f8在您的本地窗口打开的情况下单步执行代码，并观察您已声明的变量会发生什么变化以进一步详细说明。

您应该操作数组内部的值而不是工作表，只需在过程结束时可以替换一条指令中的活动表值而不是在循环中替换

请注意，您的格式不会进入您的阵列＆＃34; vData＆＃34;，它只设置usedrange的.value，因此格式化将会丢失，变量数据类型vData将抓取最接近的表观数据类型。这意味着，如果某个内容看起来像一个数字，如果它有前导零，即使它是文本，在你将它放入工作表之后，你会丢失那些前导零，那就是在api中设置值之前格式化单元格否则excel只做它最擅长的事情，我喜欢使用像

这样的东西

 sh5.cells.NumberFormat = "@"

使用嵌套Ifs更快地循环数组

2 个答案: