让 VBA 代码运行得更快答案

【问题标题】：Make the VBA code go faster让 VBA 代码运行得更快
【发布时间】：2016-04-07 17:00:00
【问题描述】：

如何让我的代码运行得更快？

当 Vlookup 处于活动状态时，它变得非常慢，我不知道如何让它变得快。

2分钟以上，和手动操作一样。

Sub 


    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "KEY"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "CHECK"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=RC[7]&RC[12]&RC[16]"
    Range("J2").Select
  Selection.AutoFill Destination:=Range("j2:j" & cells(Rows.Count, "a").End(xlUp).Row)
       Sheets("CSI Plans Report").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


Application.Calculation = xlManual

    Sheets("CSI Plan ww").Select
    Range("J1:N1").Select
    Selection.Copy
    Sheets("CSI Plans Report").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=RC[7]&RC[12]&RC[16]"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'CSI Plan ww'!C[8]:C[12],2,0)"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'CSI Plan ww'!C[7]:C[11],3,0)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],'CSI Plan ww'!C[6]:C[10],4,0)"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],'CSI Plan ww'!C[5]:C[9],5,0)"

    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)
     Range("B2").Select
    Selection.AutoFill Destination:=Range("b2:b" & cells(Rows.Count, "f").End(xlUp).Row)
     Range("C2").Select
    Selection.AutoFill Destination:=Range("c2:c" & cells(Rows.Count, "f").End(xlUp).Row)
     Range("D2").Select
     Selection.AutoFill Destination:=Range("d2:d" & cells(Rows.Count, "f").End(xlUp).Row)
     Range("E2").Select
    Selection.AutoFill Destination:=Range("e2:e" & cells(Rows.Count, "f").End(xlUp).Row)


Application.Calculation = xlAutomatic
    Range("A:E").Select
    Range("A:E").Copy
    Range("A:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


    Sheets("CSI Plan ww").Select

    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[1],'CSI Plans Report'!C[-8]:C[-3],6,0)"
    Range("I2").Select
     Selection.AutoFill Destination:=Range("i2:i" & cells(Rows.Count, "a").End(xlUp).Row)

    Columns("I:J").Copy
    Columns("I:J").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

【问题讨论】：

您提到“当 Vlookup 处于活动状态时”。您可能希望将计算模式设置为手动...Application.Calculation = xlManual。
没有标识开始工作的工作表。第一个工作表的名称是什么？（Sheets("CSI Plans Report")之前的那个）

标签： vba excel vlookup

【解决方案1】：

这个：

Range("A:E").Select
Range("A:E").Copy
Range("A:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

可以写成：

Range("A:E").Value = Range("A:E").Value

【讨论】：

【解决方案2】：

要在 excel VBA 中获得最佳性能，请尽量不要使用 Select.

而不是

Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)

最好用这个

Range("A2").AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)

最好你也可以指定工作表（但这与性能无关，这只是一个好习惯）

Sheets("someSheetName").Range("A2").AutoFill Destination:=Range("A2:A" & cells(Rows.Count, "f").End(xlUp).Row)

我强烈建议在您的子目录开始时使用

application.screenUpdating = false

这在你的潜艇的末尾

application.screenUpdating = true

因此，您的 excel 不会立即显示任何更改，而是在代码末尾立即显示。（您几乎可以在网络上的任何地方阅读有关 screenUpdating 的更多信息）

我认为这可以使您的性能得到一些提升。

【讨论】：

【解决方案3】：

如果关闭计算，您将节省大量时间，否则这些时间将用于计算只能在以后重新计算的公式。
如果您一次将公式放入所有行中，则不必进行计算；如果将它们放入单个单元格并填写，则需要运行一个计算周期。
任何时候你可以一次做多件事情总比重复做事情要好。
每个人都会告诉你read this。这是个好建议。

这是我对重写过程的贡献。

Option Explicit

Sub sonic()
    Dim lr As Long

    'uncomment the next line when you have completed debugging
    'appTGGL bTGGL:=False 'see appTGGL helper sub below for details on suspending the enviroment

    With Worksheets("CSI Plan ww")   '<~~you should know what worksheet you are on!!
        'don't insert a sinle column twice - insert 2 columns
        .Columns("I:J").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        'never do something twice when you do two things at once
        .Range("I1:J1") = Array("CHECK", "KEY")
        'write all of the formulas at once
        .Range(.Cells(2, "J"), .Cells(Rows.Count, "A").End(xlUp).Offset(0, 9)). _
            FormulaR1C1 = "=RC17&RC22&RC26"
    End With

    With Worksheets("CSI Plans Report")
        'again - all at once
        .Columns("A:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        'no need to select to make a copy
        Worksheets("CSI Plan ww").Range("J1:N1").Copy _
            Destination:=.Range("A1")
        'collect the last row so it doesn't have to be repeatedly looked up
        lr = .Cells(Rows.Count, "F").End(xlUp).Row
        'each column's formulas all at once
        .Range("A2:A" & lr).FormulaR1C1 = "=RC8&RC13&RC17"
        .Range("B2:B" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 2, 0)"
        .Range("C2:C" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 3, 0)"
        .Range("D2:D" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 4, 0)"
        .Range("E2:E" & lr).FormulaR1C1 = "=VLOOKUP(RC1,'CSI Plan ww'!C10:C14, 5, 0)"
        .Range("A2:E" & lr) = .Range("A2:E" & lr).Value2  'use .Value if any of these are dates
    End With


    With Worksheets("CSI Plan ww")
        .Range(.Cells(2, "I"), .Cells(Rows.Count, "A").End(xlUp).Offset(0, 8)). _
            FormulaR1C1 = "=VLOOKUP(RC10,'CSI Plans Report'!C1:C6, 6, 0)"
        'collect the last row so it doesn't have to be repeatedly looked up
        lr = .Cells(Rows.Count, "J").End(xlUp).Row
        'revert formulas to values
        .Range("I2:J" & lr) = .Range("I2:J" & lr).Value2  'use .Value if any of these are dates
    End With

    appTGGL 'turn everything back on

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
        .CutCopyMode = False
        .StatusBar = vbNullString
    End With
    Debug.Print Timer
End Sub

【讨论】：

你能请。解释你在这一行做了什么：.Range(.Cells(2, "J"), .Cells(Rows.Count, "A").End(xlUp).Offset(0, 9))。 _ FormulaR1C1 = "=RC17&RC22&RC26"
我不知道我做了什么，但现在又过了 2 分钟（相同的代码）。
Range object 只是使用顶部和底部单元格来定义范围。

【解决方案4】：

我在写宏的时候通常是这样的：

Public Sub MyMainMacro

   Call OnStart
    'Here comes the code
   Call OnEnd

End Sub

Public Sub OnStart()

    Application.ScreenUpdating = False
    Application.Calculation = xlAutomatic
    Application.EnableEvents = False

End Sub

Public Sub OnEnd()

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.StatusBar = False

End Sub

【讨论】：