Houtje touwtje VBA verbeteren en versnellen

[ewaldmauritz]

Ik heb middels macro opnemen de volgende VBA code gemaakt. Omdat de code erg lang is, heb ik slechts een deel van de code hier geplaatst. (zie tussenregel 'etc, etc, etc) De code doet wat ik wil, maar het duurt heel erg lang. Ik denk dat het sneller moet kunnen en de code korter. Mij ontbreekt echter de kennis om dit te doen.
Kan iemand mij hiermee helpen?

Sub Update_ingevulde_uren()
'
' Update_ingevulde_uren Macro
'
    Range("A4:NI95").Select
    Selection.Copy
    Range("A132").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC2,R132C2:R223C16,COLUMN()-1,FALSE)"
    Range("C4").Select
    Selection.AutoFill Destination:=Range("C4:G4"), Type:=xlFillValues
    Range("C4:G4").Select
    Selection.AutoFill Destination:=Range("C4:G95"), Type:=xlFillValues
    Range("C4:I95").Select
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("C4:NI95"), Type:=xlFillValues
    Range("C4:G95").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J4:N95").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Q4:U95").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'   etc, etc, etc
    Range("NB4:NG95").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("132:223").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("C4").Select
End Sub

 

[Niels28]

Zo iets=

Sub Update_ingevulde_uren()
'
' Update_ingevulde_uren Macro

Application.ScreenUpdating = False

    Range("A132").Resize(91, 373).Value = Range("A4:NI95").Value


    Range("C4").FormulaR1C1 = "=VLOOKUP(RC2,R132C2:R223C16,COLUMN()-1,FALSE)"
    Range("C4").AutoFill Destination:=Range("C4:G4"), Type:=xlFillValues
    Range("C4:G4").AutoFill Destination:=Range("C4:G95"), Type:=xlFillValues
    Range("C4:I95").AutoFill Destination:=Range("C4:NI95"), Type:=xlFillValues
    
    
    
  'deze
    For i = 0 To 364 Step 7
    Range("C4:G95").Offset(, i).Value = Range("C4:G95").Offset(, i).Value
    Next

'of
'Range("C4:NI95").Value = Range("C4:NI95").Value


    Rows("132:223").Delete Shift:=xlUp
  
End Sub

Niels

 

[Elsendoorn2134]

Ewald,

De rede waarom de macro zo traag is ligt niet aan de lengte van de macro zelf. Iedere keer dat er een wijziging plaats vind
of een getal of formule wordt ingevoerd wordt een deel van het werkboek opnieuw berekend. Als je echter een groot deel
van een werkboek veranderd duurt het wel weer even voor de berekening klaar is. Omdat je in deze macro een groot aantal
formules invoert en deze iedere keer wordt berekend wordt ook je macro traag.
De oplossing is simpel, zet de berekening gewoon uit.

Wel is het een goede methode om na het opnemen van de macro deze te bewerken om de overzichtelijkheid (en daardoor
de onderhoudbaarheid) van de macro te kunnen verbeteren.

Hierbij de code om de berekening uit (en weer aan) te zetten en een mogelijkheid tot beperking van de macro.

Sub Update_ingevulde_uren()
'
' Update_ingevulde_uren Macro
'
Dim nTeller As Integer

Application.Calculation = xlManual

Range("A4:NI95").Copy
Range("A132").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
With Range("C4")
    .FormulaR1C1 = "=VLOOKUP(RC2,R132C2:R223C16,COLUMN()-1,FALSE)"
    .AutoFill Destination:=Range("C4:G4"), Type:=xlFillValues
End With
Range("C4:G4").AutoFill Destination:=Range("C4:G95"), Type:=xlFillValues
Range("C4:I95").AutoFill Destination:=Range("C4:NI95"), Type:=xlFillValue
    
For nTeller = 1 To 4
    With Range(Choose(nTeller, "C4:G95", "J4:N95", "Q4:U95", "NB4:NG95"))
        .Copy
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
Next

Rows("132:223").Delete Shift:=xlUp
Range("C4").Select

Application.Calculation = xlCalculationAutomatic

End Sub

Veel Succes.

 

[edmoor]

Daarbij kan je dan ook nog het bijwerken van het scherm uitstellen tot de macro zijn werk heeft gedaan.

Uit:
Application.ScreenUpdating = False

Aan:
Application.ScreenUpdating = True

 

[snb]

Als je toch met VBA werkt hoef je daarmee geen formules in een werkblad te zetten. Je kunt die berekeningen ook met VBA uitvoeren en dan alleen maar de resultaten naar het werkblad schrijven.

 

[ewaldmauritz]

Allen dank voor de reactie. Het is in elk geval gelukt om m'n bestaande macro's sneller te maken. Dus dat is mooi.
Nu de betreffende macro in dit topic nog snel draaiend krijgen. Ik kom er nog op terug.

 

[ewaldmauritz]

Ik had beloofd nog even een reactie te plaatsen of het was gelukt. In tussentijd erg druk gehad, vandaar een wat late reactie. Maar het is gelukt de macro draaiend te krijgen en nog met een acceptabele bewerkingstijd ook, mede dankzij jullie suggesties. Dus allen dank voor de hulp.