宏需要很长时间才能运行答案

【问题标题】：macro taking long time to run宏需要很长时间才能运行
【发布时间】：2015-05-12 05:27:47
【问题描述】：

我有一个将数据从一列移动到另一列的宏，这个宏需要很长时间才能运行（大约 25-30 分钟）。 excel表格中的数据大约有200,000行。因为我有大约 500 张 excel 表，如果运行速度这么慢，我可能需要数周时间来清理文件，有没有更好的方法来做类似的事情，可以花费更少的时间。

Sub J_PriceAdjust()

 Dim J As Range
 Dim r As Range

 Set J = Intersect(ActiveSheet.UsedRange, Range("J:J"))

  ' Working on Column J

 For Each r In J
    If Left(r.Text, 4) = "Page" Then
        r.Copy r.Offset(0, 2)
        r.Clear
    End If
Next r

For Each r In J
    If Left(r.Text, 6) = "Amount" Or Left(r.Text, 1) = "$" Or Left(r.Text, 1) = "(" Then
        r.Copy r.Offset(0, 1)
        r.Clear
    End If
Next r

ActiveWorkbook.Save

End Sub

【问题讨论】：

ColJ 或偏移列中的任何单元格是否有公式？在运行前关闭 ScreenUpdating 并将 Calculation 设置为手动会给你一个提升。完成后不要忘记将计算设置回自动。
正如@TimWilliams 所说，始终将计算设置为手动，但不要在宏末尾盲目地将其设置为自动，而是将其重置为原始状态。用户可能有意将计算设置为手动。为此，请声明一个 xlCalculation 类型的变量来捕获原始状态，然后在最后使用此变量将其重置。
您有多种答案可供选择。我希望您会对不同的解决方案进行一些时间测试，标记对您来说最快的解决方案，并可能对每个解决方案发表评论，说明花费了多长时间。这将使这个问题成为一个很好的问题，可以作为其他提出非常相似问题的人的参考。我同意@TimWilliams 关于ScreenUpdating 和手动计算的观点——它们适用于所有答案。
非常感谢大家的付出正确答案
@mb1987 使用 Variant Array 方法（如 Jeeped 答案末尾所述）将为您带来数量级的改进

标签： vba excel

【解决方案1】：

作为根据当前代码循环遍历数据的替代方法，考虑使用AutoFilter 过滤包含所需数据的行，然后将数据复制到所需的列。我不确定在处理超过 20 万行的电子表格后它是否仍然更快，但过去我已经看到较小（但仍然很大）电子表格的性能有所提高。

请参阅下面的代码。首先，它过滤以“页面”开头的数据，然后是两列，它放置一个公式来复制该数据（我不确定是否有直接分配值的机制，但该公式似乎有效）。接下来，我清除了过滤器，然后为Amount 发布了一个新过滤器，然后在该数据的一列上放置了一个公式。

说到底，您可以在Copy 中再写一行，然后在PasteSpecial Values 中添加我们添加的公式。试一试，让我们知道它是否更有效。

Sub MakeSomeChanges()
    Dim rng As Range

    Set rng = ActiveSheet.UsedRange.Columns(10)

    rng.AutoFilter field:=1, Criteria1:="Page*"

    rng.Offset(, 2).FormulaR1C1 = "=RC[-2]"
    Sheet1.AutoFilterMode = False

    rng.AutoFilter field:=1, Criteria1:="Amount*"

    rng.Offset(, 1).FormulaR1C1 = "=RC[-1]"
    Sheet1.AutoFilterMode = False
End Sub

【讨论】：

看起来是个不错的选择。打破常规思考的荣誉！
不错。这实际上可能是最快的方法。

【解决方案2】：

至少，将两个比较合并到一个循环中可以节省对 J 列中所有单元格的迭代两次。直接值传输也比使用复制操作涉及 hte 剪贴板更快。

Sub J_PriceAdjust()

     Dim J As Range
     Dim r As Range

     Set J = Intersect(ActiveSheet.UsedRange, Range("J:J"))

      ' Working on Column J

    For Each r In J
        If Left(r.Text, 4) = "Page" Then
            r.Offset(0, 2) = r.value
            r.Clear
        ElseIf Left(r.Text, 6) = "Amount" Or Left(r.Text, 1) = "$" Or Left(r.Text, 1) = "(" Then
            r.Offset(0, 1) = r.value
            r.Clear
        End If
    Next r

    ActiveWorkbook.Save

End Sub

将单元格内容从相交处填充到变体数组中，然后处理并将它们返回到工作表en masse将是下一步。

警告：您正在单元格的 .Text 中寻找 $ 或 (。这告诉我您正在尝试匹配货币和负数，（可能是负货币）。解析单元格的显示文本很慢。解析.Value（.Value2 甚至更好）要快得多。您已经决定提供示例数据和预期结果并不重要，所以这下一个产品可能适用也可能不适用。

Sub mem_J_PriceAdjust()
     Dim v As Long, vJAYs As Variant

Debug.Print Timer
    With ActiveSheet
        vJAYs = Intersect(.Cells(1, "J").CurrentRegion, .Columns("J")).Resize(, 3).Value2

        ' Working on Column J
        For v = LBound(vJAYs, 1) To UBound(vJAYs, 1)
            If Left(vJAYs(v, 1), 4) = "Page" Then
                vJAYs(v, 3) = vJAYs(v, 1)
                vJAYs(v, 1) = vbNullString
            ElseIf Left(vJAYs(v, 1), 6) = "Amount" Then
                vJAYs(v, 2) = vJAYs(v, 1)
                vJAYs(v, 1) = vbNullString
            ElseIf IsNumeric(vJAYs(v, 1)) Then
                vJAYs(v, 2) = vJAYs(v, 1)
                vJAYs(v, 1) = vbNullString
            End If
        Next v
        Intersect(.Cells(1, "J").CurrentRegion, .Columns("J")).Resize(UBound(vJAYs, 1), 3) = vJAYs

    End With
Debug.Print Timer
    ActiveWorkbook.Save

End Sub

65K 行伪造数据的定时结果：
带值传输的单个 For/Next 循环.......................... 9.35 秒
到/从具有内存处理的批量变量数组..... 0.33 秒

显然，如果您可以确定一些可以正常处理您的数据及其基础值而不是显示的数字格式的标准，则可以大大减少处理时间。

【讨论】：

结合两个 If-s 也可以提高速度，减少不必要的操作。
同时安排你的 if 语句，使最常见的语句位于顶部，这样你就可以更频繁地跳过所有其他语句。并且“&”和“(”的 if 语句可以分开，因此不会每次都对其进行测试。
@Bigtree - 非常正确，但由于 OP 已经决定即使是对实际数据的编辑样本也太秘密而无法披露，他们不会得到最明确的建议，只会得到概括。在我看来，Page 只会在大约一百个其他组合中出现一次，但他/她已决定它应该是第一要务。这可能是错误的。

【解决方案3】：

您在同一组单元格中循环了两次，这可以改进很多。试试这个，看看你能提高多少速度：

For Each r In J
  If Left(r.Text, 4) = "Page" Then
    r.Offset(0, 2).Value=r.Value
    r.Clear
  ElseIf Left(r.Text, 6) = "Amount" Or Left(r.Text, 1) = "$" Or Left(r.Text, 1) = "(" Then
    r.Offset(0, 1).Value=r.Value
    r.Clear
  End If
Next r

J 列有哪些选项？我的意思是，你真的需要 Left 函数吗？你真的需要使用它两次吗？如果您只执行一次 left 函数，并将结果存储在一个变量中，并将其用于两个 If 语句，则可以实现一些速度增益。

【讨论】：

我将 Pdf 文件转换为 excel 格式，因此数据分散，我真的不需要 Left 函数，但找到了这种方法来找到我想要移动的确切数据

【解决方案4】：

使用内置的 Excel 函数来最小化循环。 .Find() 将比循环遍历 200k 行中的每一行要快得多。这将直接转到每次出现的“Page”，并忽略没有它的行。

Dim r as range
Dim J as range

Set r = Range("J:J").Find(what:="Page", LookIn:=xlValues, LookAt:=xlPart)
While Not r Is Nothing
  r.Offset(0, 2) = r.value
  r.Clear
  Set r = r.FindNext
Wend

Set r = Range("J:J").Find(what:="Amount", LookIn:=xlValues, LookAt:=xlPart)
While Not r Is Nothing
  r.Offset(0, 1) = r.value
  r.Clear
  Set r = r.FindNext
Wend

set J = nothing
Set r = Range("J:J").Find(what:="$", LookIn:=xlValues, LookAt:=xlPart)
While Not r Is Nothing
  if j is nothing then
    set j = r
  else
    if j <> r then
      if left(r, 1) = "$" then  'make sure the "$" is the FIRST character
        r.Offset(0, 1) = r.value
        r.Clear
        Set r = r.FindNext
      End if
    End IF
  Endif
Wend

set J = nothing
Set r = Range("J:J").Find(what:="(", LookIn:=xlValues, LookAt:=xlPart)
While Not r Is Nothing
  if j is nothing then
    set j = r
  else
    if j <> r then
      if left(r, 1) = "(" then  'make sure the "(" is the FIRST character
        r.Offset(0, 1) = r.value
        r.Clear
        Set r = r.FindNext
      End if
    End IF
  Endif
Wend

注意

.Find() 使用上次为查找例程设置的任何内容（无论是在代码中还是在对话框中），因此请确保设置尽可能多的参数。例如，向前或向后搜索可能无关紧要，只要您获得所有内容，因此您可以忽略那个。
.Find() 在到达范围末尾时也会循环并从头开始搜索，因此对于“&”和“(”搜索，您可能会在 other 的某个地方找到这些字符在您要查找它们的 .value 的开头，您必须存储找到的第一个单元格，然后将每个搜索结果与第一个结果进行比较，看看您是否回到了开头。

【讨论】：

我怀疑这会更快。 .Find 也遍历所有单元格。此外，每次找到“Page”值时，此代码都会对 J 列中的所有单元格（甚至是已经检查过的单元格）运行 .Find。似乎比原来的还要慢。
我看到的每个参考资料（抱歉，手边没有规范的列表）都表明，内置的 Excel 函数比简单地循环遍历所有单元格更快。是的，.Find 必须遍历Range("J:J") 中的所有单元格，但它使用比 VBA 更优化的编译语言来执行此操作。我想如果 OP 尝试并计算这两种方法，他会发现这明显更快。此外，我在 SO 上发布了对其他问题的非常相似的回复，人们注意到它确实运行得更快。
在这些情况下测试效果最好。你可能会感到惊讶（或者我可能会）
是的，一般来说，Excel 优化得很好。但.Find 不是，见：stackoverflow.com/questions/1857404/…
另外，您能否验证以下语句：“这将直接转到每个出现的“页面”，并忽略没有它的行。”它是怎么做到的？

【解决方案5】：

您可以先将两个循环合二为一：

Sub J_PriceAdjust()

 Dim J As Range
 Dim r As Range

 Set J = Intersect(ActiveSheet.UsedRange, Range("J:J"))

  ' Working on Column J

 For Each r In J
    If Left(r.Text, 4) = "Page" Then
        r.Copy r.Offset(0, 2)
        r.Clear
    ElseIf Left(r.Text, 6) = "Amount" Or Left(r.Text, 1) = "$" Or Left(r.Text, 1) = "(" Then
        r.Copy r.Offset(0, 1)
        r.Clear
    End If
Next r

ActiveWorkbook.Save

End Sub

虽然我会提供另一个解决方案。

【讨论】：