• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA code optimaliseren > efficienter maken

Status
Niet open voor verdere reacties.

Sukaldi

Nieuwe gebruiker
Lid geworden
10 jan 2018
Berichten
4
Hallo,

Ik heb nu een relatief simpele (ik heb nu net een week of twee ervaring met VBA) for loop geschreven die uit een range op het tabblad "Aggregatie input" een cel kopieert en plakt op het "Rekenblad". Deze cel dient als input voor verschillende formules. De uitkomsten hiervan kopieert en plakt de code vervolgens onder elkaar op het tabblad "Aggregatie complex". Af en toe gaat er echter iets mis, de identifier (de waarde die gekopieerd wordt uit de input sheet) wordt wel keurig gekopieerd en geplakt, maar de uitkomsten van de formules worden niet altijd gekopieerd, waardoor dus de waardes die bij de vorige identifier horen worden geplakt. Ik kan er geen andere reden voor verzinnen dan dat de server waarop ik werk het rekenwerk niet aankan en het daardoor misloopt, mijns inziens zit er niets geks in de for loop namelijk. Verder vond ik een linkje waarin wordt geschreven over het optimaliseren van code door het copy/pasten naar het clipboard over te slaan. Als ik die code echter wil gebruiken dan krijg ik de foutmelding 424 dat er een object mist op deze regel:

Code:
	Sheet1.Range("A1:A200").Copy Destination:=Sheet2.Range("B1")
of in mijn geval:
Code:
	"Aggregatie input".Range(.Cells(i + 3, 2).Copy Destination:=Rekenblad.Range("B9")

De code die ik gebruik staat hieronder. Mochten jullie iets weten over het efficienter laten lopen van de code (als dat mogelijk is) of een reden kunnen vinden waarom mijn code soms niet de goede regels kopieert, dan hoor ik dat graag :)

Code:
'"Complexen doorberekenen" button
Sub Complex()

Application.ScreenUpdating = False

    If MsgBox("Alle complexen worden doorgerekend, wilt u doorgaan?", vbYesNo) = vbNo Then Exit Sub
    
' Telling aantal complexen
    Worksheets("Input").Select
    Range("G6").Select
    Selection.Copy
    Range("F6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False

    hoeveel = Sheets("Input").Range("F6").Value

' Iteratie complexen
    Worksheets("Aggregatie input").Select
    Cells(4, 2).Select
    Selection.Copy
    Sheets("Rekenblad").Select
    Range("B9").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
        
    Rows("3:5").Select
    Selection.Copy
    Sheets("Aggregatie complex").Select
    Range("A1").Name = "kopieerhier"
    Range("kopieerhier").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("kopieerhier").Offset(2, 0).Name = "kopieerhier"
    
    i = 2

    For i = 2 To hoeveel
        Worksheets("Aggregatie input").Select
        Cells(i + 3, 2).Select
        Selection.Copy
        Sheets("Rekenblad").Select
        Range("B9").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    
        Sheets("Rekenblad").Select
        Rows("5:5").Select
        Selection.Copy
        Sheets("Aggregatie complex").Select
        Range("kopieerhier").Offset(1, 0).Name = "kopieerhier"
        Range("kopieerhier").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
    Next i

    Worksheets("Output").Select
    MsgBox ("Taak voltooid")
End Sub
 
Laatst bewerkt:
Sukaldi,

In je loop staat
Code:
For i = 2 To hoeveel

waar is bepaald wat de waarde van hoeveel is?
 
O dat is dom. Dat was ik vergeten mee te kopiëren. Hier staat die:

Code:
' Telling aantal complexen
    Worksheets("Input").Select
    Range("G6").Select
    Selection.Copy
    Range("F6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

    hoeveel = Sheets("Input").Range("F6").Value

G6 is een cel die het aantal niet lege cellen in een range telt.
 
Haal eerst alle overbodige selects uit uw code.
Dit werkt vertragend en is meestal overbodig.
Dit is de code van uw postje drie zonder de selects en zonder copy paste
Als je toch copy paste gebruikt is Application.CutCopyMode = False maar één maal nodig,namelijk op het einde van uw code.
Zonder vb bestandje is het verder moeilijk vast te stellen wat er fout gaat.
Code:
 With Sheets("Input")
  .Range("F6").value=  .Range("G6").value
  hoeveel = .Range("F6").Value
End With
 
Om te beginnen kan je alle Selects er eens uithalen
Code:
' Telling aantal complexen
    Sheets("Input").Range("F6") = Sheets("Input").Range("G6").Value
    hoeveel = Sheets("Input").Range("F6").Value

Verder begrijp ik niet veel van wat de code moet doen dus een voorbeeldbestandje lijkt mij wel handig.
 
Laatst bewerkt:
Oftewel:
Code:
Sub Complex()

    Application.ScreenUpdating = False

    If MsgBox("Alle complexen worden doorgerekend, wilt u doorgaan?", vbYesNo) = vbNo Then Exit Sub

    ' Telling aantal complexen
    With Worksheets("Input")
        .Range("G6").Copy
        .Range("F6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    End With
    hoeveel = Sheets("Input").Range("F6").Value

    ' Iteratie complexen
    Worksheets("Aggregatie input").Cells(4, 2).Copy
    With Sheets("Rekenblad")
        .Range("B9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                                  Operation:=xlNone, _
                                  SkipBlanks:=False, Transpose:=False
        .Rows("3:5").Copy
    End With
    With Sheets("Aggregatie complex")
        .Range("A1").Name = "kopieerhier"
        .Range("kopieerhier").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
                                                                                                    :=False, Transpose:=False
        .Range("kopieerhier").Offset(2, 0).Name = "kopieerhier"
    End With

    For i = 2 To hoeveel
        Worksheets("Aggregatie input").Cells(i + 3, 2).Copy
        Sheets("Rekenblad").Range("B9").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
                                                     Operation:=xlNone, _
                                                     SkipBlanks:=False, Transpose:=False
        Sheets("Rekenblad").Rows("5:5").Copy
        Sheets("Aggregatie complex").Range("kopieerhier").Offset(1, 0).Name = "kopieerhier"
        Range("kopieerhier").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
                                                                                                   :=False, Transpose:=False
        Application.CutCopyMode = False
    Next i

    Worksheets("Output").Select
    MsgBox ("Taak voltooid")
End Sub
Verdere optimalisatie is mogelijk door de loop eruit te halen, maar daar had ik even geen tijd voor.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan