macros需要很长时间才能运行

我有这个macros正在将数据从一列移动到另一列，这个macros需要很长时间才能运行（大约25-30分钟）。 Excel表格中的数据大约是20万行。 因为我有大约500张excel表格，如果运行速度慢，需要几个星期的时间来清理文件，有没有更好的方法来做类似的事情，可以花费更less的时间。

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 

Answer 1

作为根据当前代码循环显示数据的替代方法，可以考虑使用自动AutoFilter来筛选包含所需数据的行，然后将数据复制到所需的列。 我不确定一旦你获得了超过20万行的电子表格，它是否还会更快，但是过去我已经看到了对更小（但仍然很大）的电子表格的性能改进。

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

毕竟是说完成，你可以写一个额外的行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 

Answer 2

最低限度，将两个比较合并为一个循环将节省两次迭代J列中的所有单元格。 直接值转移也比用复制操作涉及剪贴板更快。

 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 

将单元格内容从交叉点填充到variables数组中，然后处理并将它们全部返回到工作表将是下一步。

警告：您正在寻找$或（在所显示的单元格的文本中，这表示您正在尝试匹配货币和负数（可能为负值）。解决单元格的显示文本很慢。 .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秒
到/从批量变体arrays与记忆处理….. 0.33秒

很明显，如果你能确定一些标准能够正确处理你的数据和它们的基础值，而不是显示的数字格式，你可以严格的减less处理时间。

Answer 3

你正在循环同一组单元格两次，这可以改善很多。 试试这个，看看你获得多less速度：

 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栏中的选项是什么？ 我的意思是，你真的需要左边的function吗？ 你真的需要使用两次吗？ 如果您只执行一次左函数，则可以实现一些速度增益，并将结果存储在一个variables中，并将其用于两个If语句。

Answer 4

使用内置的Excel函数来最小化循环。 .Find()将比循环遍历每行200k行更快。 这将直接发生在每一个“页面”，并忽略没有它的行。

 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()使用上次设置的查找例程（无论是在代码中还是在对话框中），所以一定要设置许多参数。 例如，只要你得到所有的东西，向前或向后search都没有关系，所以你可以忽略它。
• .Find()也会在到达范围的末尾时循环，并继续从头开始search，所以对于“＆”和“（”search，你可能会在那里find那些字符以外的地方.value你在找他们，你必须存储的第一个细胞find，然后比较每个search结果，第一个看看你是否回来在开始。

Answer 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 

虽然我会帮助另一个解决scheme。