使用嵌套 Ifs 更快地循环遍历数组答案

【问题标题】：Loop through Array with Nested Ifs Faster使用嵌套 Ifs 更快地循环遍历数组
【发布时间】：2016-10-08 16:59:04
【问题描述】：

我在一个工作表上有一组数据。我需要遍历数组，根据特定条件评估每一行，然后获取符合条件的行并将它们复制到另一个工作表。我编写了以下代码来执行此过程。

但是，循环时间过长。运行大约需要 5 分钟。我需要它在 30 秒内运行。我在 SO 上阅读了以下 q：What is the most efficient/quickest way to loop through rows in VBA (excel)?，这导致我创建了数组。我还尝试使代码保持简单。我关闭屏幕更新和启用事件。

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

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

【问题讨论】：

另外两个有助于提高性能的Application 相关提示是Application.Calculation = xlCalculationManual 和Application.DisplayAlerts = False。但在你的情况下，我不确定这些会有很大帮助
老兄！ Application.Calculation = xlCalculationManual 工作。从 5+ 分钟到
每次编写更改时，工作簿都会重新计算
将您的 If 语句与 And 组合起来，并使用 For Each 循环遍历您要评估的行。
一定要在最后加上Application.Calculation = xlCalculationAutomatic，否则每次手动输入公式复制，都会粘贴原来的结果。与DisplayAlerts (=True) 相同

标签： arrays vba excel

【解决方案1】：

另外 - 通过频繁调用 api，您会失去很多节省时间的数组功能。示例：

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

应该和

一样

 if vData(R,7)

你可能不需要循环

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

你没有在任何地方引用它，它会成倍增加指令的数量。

尝试在本地窗口打开的情况下使用 f8 单步执行您的代码，并观察您声明的变量会发生什么情况以获取更多详细信息。

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

请注意，您的格式不会包含在数组“vData”中，它只是设置 usedrange 的 .value，因此格式会下降，而变体数据类型 vData 将获取最接近的明显数据类型。这意味着当某些东西看起来像一个数字时，如果它有前导零，即使它是文本，在您将其放入工作表后您会丢失这些前导零，一种解决方法是在设置 api 中的值之前格式化单元格，否则excel只是做它最擅长的事情，我喜欢使用类似的东西

 sh5.cells.NumberFormat = "@"

【讨论】：

【解决方案2】：

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

请务必将Application.Calculation = xlCalculationAutomatic 和Application.DisplayAlerts = True 放在末尾:)

【讨论】：