• 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 bereken tijden

Status
Niet open voor verdere reacties.
H

hasuthika

Gebruiker
Lid geworden
8 nov 2018
Berichten
23
Voor een vrij groot document ben ik aan het proberen om de berekeningstijden omlaag te brengen, maar kom uit op een vreemd fenomeen.
Onderstaande de VBA code

Code: 
Sub alles()
Call readdatafromclosefile
Call berekenen
End Sub

Sub readdatafromclosefile()
    Application.Calculation = xlManual
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    
    Dim src As Workbook
    Dim pad As String
    Dim Stammap As String
    
    Worksheets("Stammap meetvoorschrift").Range("B2:H500").Copy
    
    Worksheets("Stammap meetvoorschrift").Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Worksheets("Stammap meetvoorschrift").Select
    Range("J2:AC2").Select
    Selection.AutoFill Destination:=Range("J2:AC500"), Type:=xlFillDefault
    Range("J2").Select
                   
End Sub

Sub berekenen()
Calculate
End Sub

Als ik voor bovenstaande code:
'alles' laat lopen dan duurt het 36 seconden
'readdatafromclosefile' laat lopen dan duurt het 5 seconden
'berekenen' laat lopen dan duurt het 10 seconden.

'alles' = 'readdatafromclosefile' + 'berekenen'
36 = 5 + 10

Bij mij is 5 + 10 = 15, geen 36...
Hoe kan het dat dit verschil aanwezig is en hoe krijg ik het weg?
 
Geen idee over de tijden, maar select en selection zijn overbodig evenals de sub 'calculate'.
bv, onderstaand stukje.

Code: 
Worksheets("Stammap meetvoorschrift").Range("B2:H500").Copy
    
    Worksheets("Stammap meetvoorschrift").Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Dit doet hetzelfde...
Code: 
with Worksheets("Stammap meetvoorschrift")
  .Range("B2:H500") = .range("B2:H500").value
end with
 
@ExcelAmateur
Dit heeft geen (<1s) effect op de berekening, ik had hem nog verkeerd staan.
We hebben gekeken of dit met 'true' beter zou werken, echter is dit niet het geval...

HSV zei:
Geen idee over de tijden, maar select en selection zijn overbodig evenals de sub 'calculate'.
bv, onderstaand stukje.
Klik om te vergroten...
Klopt. Dit hebben we gedaan om het apart te testen. Als ik 'calculate' onderaan in 'readdatafromclosefile' zet duurt het net zolang als dat ik ze beide oproep.
Als ik ze apart oproep heb ik dat tijdsverschil.


Code: 
with Worksheets("Stammap meetvoorschrift")
  .Range("B2:H500") = .range("B2:H500").value
end with
Dankjewel! Dit was mij nog niet bekend :)



Ben er zojuist achter gekomen dat er ook tijdsverschil zit in het uitvoeren van 'calculate' in VBA met de F9 hotkey, wat hetzelfde zou moeten zijn.
Hier zit een verschil van 4-5 seconden in dat F9 sneller is...
 
Laatst bewerkt door een moderator:
Misschien kun je het bestand eens plaatsen zodat de code versneld kan worden.
Ik ben benieuwd waarom je 'AutoFill' gebruikt.
'AutoFill' is op zich traag.
 
Laatst bewerkt door een moderator:
Sorry, ik kan het document niet plaatsen omdat het bedrijfsgevoelige informatie is. Ik kan ook geen testdocument maken omdat het om veel data gaat die ik moet 'verzinnen' (500 rijen x 6 kolommen).
Echter kan ik wel laten zien wat ik gedaan heb in VBA.
Onderstaande is de gehele code die ik gebruik.
Helemaal onderaan heb ik een stukje gebouwd dat elk tabblad afzonderlijk berekend en deze tijd wegschrijft in het eerste tabblad. Hiermee kan ik zien hoelang elk tabblad er over doet voor te berekenen. Ik weet dat deze methode langer duurt dan 'calculate' te gebruiken, maar zo kan ik wel zien welke tab problemen opleverd.
Wat ik hierin zie is dat het eerste tabblad het langste duurt, terwijl ik deze leeg heb gemaakt van formules, namen en voorwaardelijke opmaak.

Code: 
Sub readdatafromclosefile()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim src As Workbook
    Dim pad As String
    Dim Stammap As String
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O22").Value = Now
    
    Worksheets("Stammap meetvoorschrift").Range("A1").Calculate
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O23").Value = Now
        
    pad = Worksheets("Stammap meetvoorschrift").Range("A1")
    
    Set src = Workbooks.Open(pad, False, True)
    
    src.Worksheets("Meetvoorschrift A").Range("A9:G500").Copy
    
    Windows("Meetmiddelen V4.xlsm").Activate
    Sheets("Stammap meetvoorschrift").Activate
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O24").Value = Now
    
    src.Close False
    Set src = Nothing
            
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O25").Value = Now
    
    Columns("B:B").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O28").Value = Now
    
    Worksheets("Stammap meetvoorschrift").Select
    Range("J2:AC2").Select
    Selection.AutoFill Destination:=Range("J2:AC500"), Type:=xlFillDefault
    Range("J2").Select
        
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O26").Value = Now
    
    Worksheets("Gefilterde lijst meetmiddelen").Select
    Range("A4:DR4").Select
    Selection.AutoFill Destination:=Range("A4:DR100"), Type:=xlFillDefault
    Range("A4").Select
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O27").Value = Now
    
    Sheets("Uitgeven").Activate
    
    'Application.Calculation = xlAutomatic
    'Calculate
    Worksheets("Uitgeven").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O29").Value = Now
    Worksheets("Retour").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O30").Value = Now
    Worksheets("Stammappen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O31").Value = Now
    Worksheets("Blad3").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O32").Value = Now
    Worksheets("Blad2").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O33").Value = Now
    Worksheets("Lijst").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O34").Value = Now
    Worksheets("Lijst meetmiddelen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O35").Value = Now
    Worksheets("Blad1").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O36").Value = Now
    Worksheets("Gefilterde lijst meetmiddelen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O37").Value = Now
    Worksheets("Stammap meetvoorschrift").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O38").Value = Now
End Sub

Zonder die onderste regels waar hij de tabs apart gaat berekenen (ophalen van informatie van de server) duurt het 5 seconden, met het berekenen 36 seconden en apart berekenen na het apart ophalen duurt 10 seconden.
Onderstaande een afbeelding waar het tijdsverschil te zien is. Bij dit artikel duurt het ophalen maar 4 seconden en het berekenen 84 seconden...
test.png
 
Laatst bewerkt:
We hoeven geen testdocument met 500 rijen.

Wel werkboek is Thisworkbook?
Is dat?
Code: 
 Workbooks("Meetmiddelen V4.xlsm")

Zo ja, dan staan er een heleboel overbodige zaken in.

Code: 
[COLOR=#3E3E3E]Worksheets("Uitgeven").Range("O29").resize(10) = Now[/COLOR]
Doet hetzelfde als.
Code: 
 Worksheets("Uitgeven").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O29").Value = Now
    Worksheets("Retour").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O30").Value = Now
    Worksheets("Stammappen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O31").Value = Now
    Worksheets("Blad3").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O32").Value = Now
    Worksheets("Blad2").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O33").Value = Now
    Worksheets("Lijst").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O34").Value = Now
    Worksheets("Lijst meetmiddelen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O35").Value = Now
    Worksheets("Blad1").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O36").Value = Now
    Worksheets("Gefilterde lijst meetmiddelen").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O37").Value = Now
    Worksheets("Stammap meetvoorschrift").Calculate
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O38").Value = Now
 
Het werkboek waar de code instaat is 'Meetmiddelen V4.xlsm'.
Onderstaande zal ik proberen, echter denk ik niet dat dat het probleem op gaat lossen...
 
Denk het wel.
 
Hij is inderdaad vele malen sneller, ik krijg hem nu niet getimed :)
Echter berekent hij de opgevraagde gegevens nu niet...
Achter de code heb ik nog 'calculate' toegevoegd en opnieuw getimed. Het duurt nu in totaal 31 seconden in plaats van 1m28s.

Kan je me uitleggen waarom dit vele malen sneller is? Ik begrijp dit stukje namelijk niet, aangezien hij nu toch opnieuw berekend...
Onderstaande de huidige code:
Code: 
Sub readdatafromclosefile()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Dim src As Workbook
    Dim pad As String
    Dim Stammap As String
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O22").Value = Now
    
    Worksheets("Stammap meetvoorschrift").Range("A1").Calculate
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O23").Value = Now
        
    pad = Worksheets("Stammap meetvoorschrift").Range("A1")
    
    Set src = Workbooks.Open(pad, False, True)
    
    src.Worksheets("Meetvoorschrift A").Range("A9:G500").Copy
    
    Windows("Meetmiddelen V4.xlsm").Activate
    Sheets("Stammap meetvoorschrift").Activate
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O24").Value = Now
    
    Columns("B:B").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
    src.Close False
    Set src = Nothing
            
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O25").Value = Now
    
    Worksheets("Stammap meetvoorschrift").Select
    Range("J2:AC2").Select
    Selection.AutoFill Destination:=Range("J2:AC500"), Type:=xlFillDefault
    Range("J2").Select
        
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O26").Value = Now
    
    Worksheets("Gefilterde lijst meetmiddelen").Select
    Range("A4:DR4").Select
    Selection.AutoFill Destination:=Range("A4:DR100"), Type:=xlFillDefault
    Range("A4").Select
    
                    Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O27").Value = Now
    
    Sheets("Uitgeven").Activate
    
    'Application.Calculation = xlAutomatic
    Calculate
    
Worksheets("Uitgeven").Range("O29").Resize(10) = Now

End Sub
 
Het kan nog vele malen sneller zonder select, selection, 'Workbooks("Meetmiddelen V4.xlsm")' en met mijn suggesties die nog niet zijn aangepast in je code.

Maar ja, ik bouw geen bestanden na die omvangrijk zijn.
 
Alle
Code: 
Workbooks("Meetmiddelen V4.xlsm").Worksheets("Uitgeven").Range("O23").Value = Now
ga ik uit de code halen, dit was puur om te kijken waar de grote vertraging zit.

Hetgeen je in post #3 hebt gezegt, is dat nog steeds haalbaar in de huidige code waar ik het van een ander werkboek kopieer? Zoiets als onderstaande?
Code: 
Workbooks("Meetmiddelen V4.xlsm").Worksheets("Stammap meetvoorschrift").Range("B2:H493").Value = src.Worksheets("Meetvoorschrift A").Range("A9:G500")

Klopt het dat ik
Code: 
Columns("B:B").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
kan vervangen door
Code: 
Columns("B:B").Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
Dit...
Code: 
Workbooks("Meetmiddelen V4.xlsm").Worksheets("Stammap meetvoorschrift").Range("B2:H493").Value = src.Worksheets("Meetvoorschrift A").Range("A9:G500")
....veranderen in.
Code: 
thisworkbook.sheets("Stammap meetvoorschrift").Range("B2:H493") = src.sheets("Meetvoorschrift A").Range("A9:G500").value


Klopt het dat ik
Code: 
Columns("B:B").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

kan vervangen door
Code: 
Columns("B:B").Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Klopt, maar het kan ook anders.

Code: 
columns(2).replace ".",",", xlpart
of:
Code: 
columns(2).replace ".",",",2
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan