使VBA代码更快

时间：2016-04-07 05:48:54

标签： excel vba excel-vba vlookup

如何让我的代码更快？

当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

4 个答案:

答案 0 :(得分：3)

此：

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

答案 1 :(得分：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的信息）

我认为这可以让你获得一些性能提升。

答案 2 :(得分：1)

  1. 如果您关闭计算，您将节省大量时间，否则将用于计算仅在以后重新计算的公式。
  2. 如果您将公式一次性放入所有行，则无需进行计算;如果你将它们放入一个单元格并填充，你需要运行一个计算周期。
  3. 任何时候你可以一次做多件事比做反复做事好。
  4. 每个人都会告诉你read this。这是一个很好的建议。

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

    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

答案 3 :(得分：0)

我通常在编写宏时执行以下操作：

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
相关问题
最新问题