Lassen Sie den VBA-Code schneller gehen

Question

Wie kann ich meinen Code schneller machen?

Es ist wirklich langsam, wenn der Vlookup aktiv ist und ich nicht weiß, wie es schnell gehen kann.

Es dauert mehr als 2 Minuten und es ist das gleiche wie manuell.

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. Wenn Sie Berechnung deaktivieren Sie geraume Zeit hinweg sparen, die sonst auf der Berechnung Formeln gewidmet werden würde, die nur zu einem späteren Zeitpunkt neu zu berechnen.
2. Wenn Sie Ihre Formeln in alle Zeilen auf einmal eingeben, müssen Sie die Berechnung nicht durchführen; Wenn Sie sie in eine einzelne Zelle setzen und ausfüllen, müssen Sie einen Berechnungszyklus ausführen.
3. Immer wenn Sie mehrere Dinge auf einmal tun können, ist es besser als Dinge wiederholt zu tun.
4. Jeder wird Ihnen sagen, read this. Es ist ein guter Rat.

Hier ist mein Beitrag zum Neuschreiben.

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

auf beste Leistung in Excel-VBA versuchen zu erreichen nicht Select.

statt

verwenden diese

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

bessere Nutzung

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

Und das Beste, was Sie tun können, ist zu spezifiziere auch das Blatt (aber es hat nichts mit der Leistung zu tun, es ist nur eine gute Übung)

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

Und ich stark von Anfang Ihrer Unter empfehlen

application.screenUpdating = false 

und diese auf Ende des Unter verwenden

application.screenUpdating = true 

So Ihre Excel zeigen wird nicht jede Änderung imediately, aber bei einmal am Ende des Codes. (Sie können fast überall im Web mehr über screenUpdating lesen)

Ich denke, das kann Ihnen einen Leistungsschub bringen.

Answer 3

Dies:

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

kann nur geschrieben werden:

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

Answer 4

Was ich in der Regel tun, wenn Makros schreiben, ist die folgende:

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