Сделайте код VBA быстрее и быстрее

Question

Как сделать код быстрее?

Это происходит очень медленно, когда 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. Если отключить расчет вы будете экономить значительные периоды времени, которые могли бы быть посвящен вычислению формул, только для пересчета позже.
2. Если вы поместите свои формулы во все строки сразу, вам не нужно вычислять; если вы помещаете их в одну ячейку и заполняете, вам нужно запустить цикл вычисления.
3. В любое время, когда вы можете делать несколько вещей одновременно, лучше, чем делать что-то неоднократно.
4. Все скажут вам 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 

Answer 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 

Так что ваш первенствует обыкновение показывать какие-либо изменения imediately, но в один раз в конце кода. (вы можете больше узнать о screenUpdating почти везде на веб-сайте)

Я думаю, что это может привести к некоторому повышению производительности.

Answer 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 

Answer 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