使VBA代码更快

我怎样才能让我的代码更快？

当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 

Answer 1

1. 如果closures计算，则可以节省大量时间，否则这些时间将专门用于计算稍后将被重新计算的公式。
2. 如果您将公式一次放入所有行，则不必计算; 如果你把它们放到一个单元格中并填满，你需要运行一个计算周期。
3. 任何时候你可以一次做多件事情比反复做事更好。
4. 每个人都会告诉你读这个 。 这是个好build议。

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

 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 

Answer 2

这个：

 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 

Answer 3

在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) 

而且你所能做的最好的事情就是指定工作表（但它与performance无关，它只是一个好的做法）

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

而且我强烈build议您在开始使用sub

 application.screenUpdating = false 

这在你的子结束

 application.screenUpdating = true 

所以你的excel不会立即显示任何变化，而是在代码的最后。 （你可以阅读更多关于screenUpdating几乎在任何networking上）

我认为这可以使你的performance有所提升。

Answer 4

编写macros时我通常会这样做：

 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