使 VBA 代码运行得更快 [英] Make the VBA code go faster

问题描述

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

How can i make my code go faster?

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

It's go real slow when the Vlookup is active and i don't know how to make it go fast.

耗时 2 多分钟，和手动操作一样.

It takes more than 2 minute and it's the same as doing manually.

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

推荐答案

1. 如果您关闭计算，您将节省大量时间，否则这些时间将专门用于计算以后需要重新计算的公式.
2. 如果您一次将公式放入所有行，则不必进行计算；如果将它们放入一个单元格中并向下填充，则需要运行一个计算周期.
3. 任何时候你可以一次做多件事总比重复做要好.
4. 每个人都会告诉您阅读此内容.这是个好建议.

1. If you turn off calculation you will save significant periods of time that would otherwise be devoted to calculating formulas that are only oin to be recalculated later.
2. If you put your formulas into all the rows at once, you do not have to have the calculation on; if you put them into a single cell and fill down you need to run a calculation cycle.
3. Anytime you can do multiple things at once is better than doing things repeatedly.
4. Everyone will tell you to read this. It is good advice.

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

Here's is my contribution to the rewrite process.

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

这篇关于使 VBA 代码运行得更快的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！