Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: Procedure snelheid klokken(meten)  (gelezen 17729 keer)

0 leden en 1 gast bekijken dit topic.

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Procedure snelheid klokken(meten)
« Gepost op: 18 april 2019, 14:49:04 »
Hallo Helpers en oplossers,

Is het mogelijk om op een zo simpel mogelijke manier de snelheid van een VBA procedure te klokken?

Mijn gedachte zou zijn

sub <mijn procedure>
start klok

<<<-Mijn Code->>>

Stop klok
Uitkomst klok via msgbox
end sub

Alvast bedankt voor het eventuele antwoord ;)
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline Ex-lid

  • Oplosser
  • ****
  • Berichten: 670
  • Geslacht: Man
  • dit lid is verbannen
Re: Procedure snelheid klokken(meten)
« Reactie #1 Gepost op: 18 april 2019, 15:23:06 »
Hoi Josc,
Ik heb een kant en klare timer voor je, dat is het probleem niet, maar  ik heb het gevoel dat dit je vraag niet is.
Het is misschien beter om de code eens door te lichten. als je denkt dat een macro langzaam is.

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #2 Gepost op: 18 april 2019, 15:53:39 »
Hoi Dotchiejack,
Dank voor je respons. Ik zal proberen uit te leggen waar ik mee bezig ben, en waarom ik geïnteresseerd ben in het klokken van mijn procedures. Ik ben een aantal jaren geleden begonnen mij te begeven op het pad van VBA en met vele hulp van dit forum ben ik meer en meer ingevoerd geraakt met het gebruik hiervan. Daardoor ben ik afgelopen week aan een grote revisie van mijn code begonnen waardoor ik al tientallen regels code heb weten te  besparen en ben ik nu wel eens benieuwd of dit qua tijd zin heeft gehad, en hoeveel ;) Ik vind mijn procedure dus niet per definitie "traag"

Om je een inkijkje in de verschillen van 1 van de  procedures in mijn macro te geven zal ik de oude procedure en de vernieuwing hieronder plaatsen.

eerst de oude:
Sub Jaarjournaal()
       
'=========================================================================
'Deze routine schrijft de berekende gegevens naar het blad "Jaar Journaal"
'in maximaal 5 regels afhankelijk van de ingevoerde optie's.
'=========================================================================

With Blad2
    BTWL = .Range("B10").Value
    BTWH = .Range("B11").Value
End With

'=================================================================
'Eerst wordt in de factuurregel de benodigde gegevens opgehaald,
'die elk factuur minimaal bevat: Factuurnr, Ritprijs en commissie.
'=================================================================

With Blad10

    A = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        Factuurnummer = .Range("A" & A).Value
        Ritprijs = .Range("K" & A).Value
        BTW6 = .Range("L" & A).Value
        NtoRitprijs = Ritprijs - BTW6
        '####################################################################
        'in geval van NoCommissie worden de volgende regels niet doorgevoerd.
        '####################################################################
        Comm = .Range("Q" & A).Value + .Range("R" & A).Value
        BTW21 = .Range("R" & A).Value
        NtoComm = .Range("Q" & A).Value

'=====================================================================
'Indien de rit op Schiphol is gestart wordt er een toeslag berekend.
'Dit houdt in dat er 2 extra regels worden toegevoegd in het journaal.
'=====================================================================

    If .Range("N" & A).Value <> "" Then
        SchipholPas = .Range("N" & A).Value
        SchipholBTW6 = .Range("O" & A).Value
        NtoSchiphol6 = SchipholPas - SchipholBTW6
        BTWSchipholPas = .Range("S" & A).Value + .Range("T" & A).Value
        SchipholBTW21 = .Range("T" & A).Value
        NtoSchiphol21 = .Range("S" & A).Value
    End If

'=============================================================================
'Wanneer er fooi is gegeven via de app, dan komt ook daarvoor een extra regel.
'=============================================================================

    If .Range("P" & A).Value <> "" Then
        FOOI = .Range("P" & A).Value
    End If

'================================================================
'Als de rit gedeeld wordt, krijgen we nog te maken met de aftrek.
'================================================================

    If .Range("U" & A).Value <> "" Then
        Deel = .Range("U" & A).Value
        DeelBTW = .Range("V" & A).Value
    End If

'===========================================================================================================
'Als het een correctiefactuur betreft, zetten we geen "Weekomzet" Maar "Correctie" Als factuur omschrijving.
'===========================================================================================================

    If .Range("AD" & A).Value <> "" Then
        Correctie = .Range("AD" & A).Value
    End If

'=================================================
'Rest nog te bepalen hoe de betaling wordt gedaan.
'=================================================

    If .Range("AL" & A).Value = "X" Then
        Ontvangen = "Izettle"
    ElseIf .Range("AL" & A).Value = "C" Then
        Ontvangen = "Cash"
    Else
        Ontvangen = "Bank"
    End If
   
End With

'=======================
'Boekstuknummer bepalen!
'=======================

            With Sheets("Legenda").Columns(19)
               
                weeknummer = DatePart("ww", DateValue(Me.TxtDatum), vbMonday, vbFirstFourDays)
                    Set bs = .Find(weeknummer)
                        WO = bs.Offset(, 3).Value   'weekomzet boekstuknummer
                        CM = bs.Offset(, 4).Value   'commissie boekstuknummer
                        SP = bs.Offset(, 5).Value   'Schiphol + boekstuknummer
                        SM = bs.Offset(, 6).Value   'Schiphol - boekstuknummer
                        RD = bs.Offset(, 7).Value   'ritprijs delen boekstuknummer
                        FO = bs.Offset(, 8).Value   'Fooi boekstuknummer
            End With
 
'==========================================
'Activering van het doelblad: JaarJournaal.
'==========================================

With Blad1

        B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
            If .Range("A1").Value = 0 Then
                B = B - 1
            End If
           
        .Range("A" & B + 1).Value = WO
        .Range("B" & B + 1).Value = Sheets("Legenda").Range("D2") + 1
        .Range("C" & B + 1).Value = "I"
        .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
        .Range("F" & B + 1).Value = "Verkopen Laag"
        .Range("H" & B + 1).Value = "Weekomzet"
        .Range("I" & B + 1).Value = Factuurnummer
        .Range("J" & B + 1).Value = Ontvangen
        .Range("K" & B + 1).Value = BTWL
        .Range("L" & B + 1).Value = Ritprijs
        .Range("M" & B + 1).Value = BTW6
        .Range("N" & B + 1).Value = NtoRitprijs
        .Range("O" & B + 1).Value = BTW6
        .Range("Q" & B + 1).Value = NtoRitprijs
       
       

'========================
'Commissie inclusief BTW.
'========================
        If ChckNoComm.Value = False Then
       
            B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
            .Range("A" & B + 1).Value = CM
            .Range("B" & B + 1).Value = Sheets("Legenda").Range("D4") + 1
            .Range("C" & B + 1).Value = "UI"
            .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
            .Range("F" & B + 1).Value = "Commissie"
            .Range("H" & B + 1).Value = "Commissie"
            .Range("I" & B + 1).Value = Factuurnummer
            .Range("J" & B + 1).Value = Ontvangen
            .Range("K" & B + 1).Value = BTWH
            .Range("L" & B + 1).Value = Comm
            .Range("M" & B + 1).Value = BTW21
            .Range("N" & B + 1).Value = NtoComm
            .Range("P" & B + 1).Value = BTW21
            .Range("W" & B + 1).Value = NtoComm
       
        Else
        End If
       

'=======================
'Is het een schipholrit?
'=======================

    If SchipholPas <> "" Then
        B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        .Range("A" & B + 1).Value = SP
        .Range("B" & B + 1).Value = Sheets("Legenda").Range("D2") + 1
        .Range("C" & B + 1).Value = "I"
        .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
        .Range("F" & B + 1).Value = "Verkopen Laag"
        .Range("H" & B + 1).Value = "Schiphol/Uber"
        .Range("I" & B + 1).Value = Factuurnummer
        .Range("J" & B + 1).Value = Ontvangen
        .Range("K" & B + 1).Value = BTWL
        .Range("L" & B + 1).Value = SchipholPas
        .Range("M" & B + 1).Value = SchipholBTW6
        .Range("N" & B + 1).Value = NtoSchiphol6
        .Range("O" & B + 1).Value = SchipholBTW6
        .Range("R" & B + 1).Value = NtoSchiphol6

        B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        .Range("A" & B + 1).Value = SM
        .Range("B" & B + 1).Value = Sheets("Legenda").Range("D4") + 1
        .Range("C" & B + 1).Value = "UI"
        .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
        .Range("F" & B + 1).Value = "Autokosten"
        .Range("H" & B + 1).Value = "BTW Schipholcard"
        .Range("I" & B + 1).Value = Factuurnummer
        .Range("J" & B + 1).Value = Ontvangen
        .Range("K" & B + 1).Value = BTWH
        .Range("L" & B + 1).Value = BTWSchipholPas
        .Range("M" & B + 1).Value = SchipholBTW21
        .Range("N" & B + 1).Value = NtoSchiphol21
        .Range("P" & B + 1).Value = SchipholBTW21
        .Range("X" & B + 1).Value = NtoSchiphol21
    End If

'===================
'Is er fooi gegeven?
'===================

    If FOOI <> "" Then
        B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        .Range("A" & B + 1).Value = FO
        .Range("B" & B + 1).Value = Sheets("Legenda").Range("D2") + 1
        .Range("C" & B + 1).Value = "I"
        .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
        .Range("F" & B + 1).Value = "Verkopen Overig"
        .Range("H" & B + 1).Value = "Fooien"
        .Range("I" & B + 1).Value = Factuurnummer
        .Range("J" & B + 1).Value = Ontvangen
        .Range("K" & B + 1).Value = "0"
        .Range("L" & B + 1).Value = FOOI
        .Range("S" & B + 1).Value = FOOI
    End If

'========================
'Is het een gedeelde rit?
'========================

    If Deel <> "" Then
        B = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        .Range("A" & B + 1).Value = RD
        .Range("B" & B + 1).Value = Sheets("Legenda").Range("D4") + 1
        .Range("C" & B + 1).Value = "UI"
        .Range("D" & B + 1).Value = DateValue(Me.TxtDatum)
        .Range("F" & B + 1).Value = "Verkopen Laag"
        .Range("H" & B + 1).Value = "Gedeelde rit"
        .Range("I" & B + 1).Value = Factuurnummer
        .Range("J" & B + 1).Value = Ontvangen
        .Range("K" & B + 1).Value = BTWH
        .Range("L" & B + 1).Value = Deel + DeelBTW
        .Range("M" & B + 1).Value = DeelBTW
        .Range("N" & B + 1).Value = Deel
        .Range("P" & B + 1).Value = DeelBTW
        .Range("Y" & B + 1).Value = Deel
    End If
   
End With

'============================
'Terug naar het facturenblad.
'============================

Range("A" & Rows.Count).End(xlUp).Activate
Blad10.Activate
End Sub

En de nieuwe:
Sub Jaarjournaal()
'v6,4a Optimalisatie verwerkingsregels (17/4/19)
'BTW pecentage ophalen
With Blad2
    BTWL = .Range("B10").Value
    BTWH = .Range("B11").Value
End With

'Inlezen benodigde waardes
With Blad10
'Ritomzet en Commissie (2 rijen, 1 indien er geen commissie wordt geheven)
    A = .Cells(Cells.Rows.Count, 1).End(xlUp).Row
        Fnr = .Cells(A, 1)      'Factuurnummer
        OiB = .Cells(A, 11)     'Omzet incl 9% BTW
        O9B = .Cells(A, 12)     '9% BTW van de Omzet
        OeB = .Cells(A, 13)     'Omzet excl 9% BTW
        CeB = .Cells(A, 17)     'Commissie excl 21% BTW
        C21B = .Cells(A, 18)    '21% BTW over Commissie
        Comm = CeB + C21B       'Commissie incl 21% BTW
'Schipholritten (2 rijen)
    If .Cells(A, 14) <> "" Then
        STiB = .Cells(A, 14)    'SchipholToeslag incl 9% BTW
        ST9B = .Cells(A, 15)    '9% BTW van de SchipholToeslag
        STeB = .Cells(A, 19)    'SchipholToeslag excl 9% / 21% BTW
        ST21B = .Cells(A, 20)   '21% BTW over netto SchipholToeslag
        BiTS = ST21B + STeB     'Schipholtoeslag incl 21% BTW
    End If
'Fooi (1 rij)
    If .Cells(A, 16) <> "" Then
        FOOI = .Cells(A, 16)    'ontvangen Fooi
    End If
'Gedeelde ritprijs (1 rij)
    If .Cells(A, 21) <> "" Then
        Deel = .Cells(A, 21)    'Gedeelde rit
        D21B = .Cells(A, 22)    '21% BTW over de gedeelde rit
    End If
'Als het een correctiefactuur betreft, zetten we geen "Weekomzet" Maar "Correctie" Als factuur omschrijving.
    If .Cells(A, 30) <> "" Then
        CRR = "Correctie"
    End If
'Betalingsmogelijkheden
    If .Cells(A, 38) = "X" Then
        Ontv = "Izettle"        'Afgerekend middels pin betaling
    ElseIf .Cells(A, 38) = "C" Then
        Ontv = "Cash"           'Afgerekend met klinkende munt
    Else
        Ontv = "Bank"           'Wekelijkse storting door Uber
    End If
'Inlezen benodigde waardes is hiebij afgerond.
End With

'Ieder onderdeel krijgt een "INTERN" boekstuknummer toegewezen, nodig om in te kunnen lezen in het BTW overzicht.
            With Sheets("Legenda").Columns(19)
               
                weeknummer = DatePart("ww", DateValue(Me.TxtDatum), vbMonday, vbFirstFourDays)
                    Set bs = .Find(weeknummer)
                        BSN = bs.Row
                        DD = DateValue(Me.TxtDatum) 'Ritdatum
                        BD = .Cells(BSN + 1, 2)     'Bankdatum
                        WO = .Cells(BSN, 4)         'Weekomzet boekstuknummer
                        CM = .Cells(BSN, 5)         'Commissie boekstuknummer
                        SP = .Cells(BSN, 6)         'Schiphol + boekstuknummer
                        SM = .Cells(BSN, 7)         'Schiphol - boekstuknummer
                        RD = .Cells(BSN, 8)         'Ritprijs delen boekstuknummer
                        FO = .Cells(BSN, 9)         'Fooi boekstuknummer
            End With
'Boekstuknummers zijn ingelezen, dan nu door naar het invullen van het Jaarjournaal

With Blad1

    Application.ScreenUpdating = False
'Eerst wordt bepaald welke onderdelen een waarde hebben, indien een waarde dan krijgt het een omschrijving mee
    If CRR <> "" Then OM1 = "Correctie" Else OM1 = "Weekomzet"
    If Comm <> "" Then OM2 = "Commissie" Else OM2 = ""
    If STiB <> "" Then OM3 = "Schiphol/Uber" Else OM3 = ""
    If BiTS <> "" Then OM6 = "BTW Schipholcard" Else OM6 = ""
    If FOOI <> "" Then OM4 = "Fooien" Else OM4 = ""
    If Deel <> "" Then OM5 = "Gedeelde Rit" Else OM5 = ""
   
    OM = Array(OM1, OM2, OM3, OM6, OM4, OM5)
'Elke "Case" is een regel in het Jaarjournaal, alleen diegene met een waarde worden meegenomen
        For ii = 1 To 6
            If OM(ii) = "" Then GoTo Volgende
        Select Case OM(ii)
            Case OM1
                X = Array(WO, Sheets("Legenda").Range("D2") + 1, "I", DD, BD, "Verkopen Laag", "", OM1, Fnr, Ontv, BTWL, OiB, O9B, OeB, O9B, "", OeB)
                eind = 17
            Case OM2
                If ChckNoComm.Value = False Then
                Ontv = "Omzet"
                X = Array(CM, Sheets("Legenda").Range("D4") + 1, "UI", DD, BD, OM2, "", OM2, Fnr, Ontv, BTWH, Comm, C21B, CeB, "", C21B, "", "", "", "", "", "", CeB)
                eind = 23
                Else
                GoTo Volgende
                End If
            Case OM3
                If STiB <> "" Then
                Ontv = "Omzet"
                X = Array(SP, Sheets("Legenda").Range("D2") + 1, "I", DD, BD, "Verkopen Laag", "", OM3, Fnr, Ontv, BTWL, STiB, ST9B, STeB, ST9B, "", "", STeB)
                eind = 18
                Else
                GoTo Volgende
                End If
            Case OM6
                If STiB <> "" Then
                Ontv = "Omzet"
                X = Array(SM, Sheets("Legenda").Range("D4") + 1, "UI", DD, BD, "Autokosten", "", OM6, Fnr, Ontv, BTWH, BiTS, ST21B, STeB, "", ST21B, "", "", "", "", "", "", "", STeB)
                eind = 24
                Else
                GoTo Volgende
                End If
            Case OM4
                If FOOI <> "" Then
                Ontv = "Bank"
                X = Array(FO, Sheets("Legenda").Range("D2") + 1, "I", DD, BD, "Verkopen Overig", "", OM4, Fnr, Ontv, "0", FOOI, "", "", "", "", "", "", FOOI)
                eind = 19
                Else
                GoTo Volgende
                End If
            Case OM5
                If Deel <> "" Then
                Ontv = "Omzet"
                X = Array(RD, Sheets("Legenda").Range("D4") + 1, "UI", DD, BD, "Verkopen Laag", "", OM5, Fnr, Ontv, BTWH, Deel + D21B, D21B, Deel, "", D21B, "", "", "", "", "", "", "", "", Deel)
                eind = 25
                Else
                GoTo Volgende
                End If
        End Select
           
        Application.Calculation = xlCalculationManual
'Na het doorlopen van enkele "Case" Specifieke regels volgt het feitelijk invullen
            j = .Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                If .Range("A1").Value = 0 Then
                    j = j - 1
                End If
                y = 1
                For i = 1 To eind
                    .Cells(j, i) = X(y)
                    y = y + 1
                Next i
               
        Application.Calculation = xlCalculationAutomatic
       
Volgende:
        Next ii
   
    Application.ScreenUpdating = True
   
End With

'Terug naar het facturenblad.
Range("A" & Rows.Count).End(xlUp).Activate
Blad10.Activate
End Sub
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline Haije

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 197
  • Geslacht: Man
  • Oplossing.be
Re: Procedure snelheid klokken(meten)
« Reactie #3 Gepost op: 18 april 2019, 18:38:31 »
probeer dit eens:

sub <mijn procedure>
start =timer
<<<-Uw Code->>>

Stop - timer
msgbox "het duurde " & stop-start &" sec."
end sub
|-|aije

ik gebruik Office 2016 Professional Plus

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Procedure snelheid klokken(meten)
« Reactie #4 Gepost op: 18 april 2019, 19:59:59 »
@ Haije,

je bedoelt waarschijnlijk stop = timer, maar dan vrees ik dat het nog niet lukt vermits "stop" niet als variabele zal aanvaard worden.

@ Johan,

Redelijke kans dat je het zelf goed hebt gekregen, denk ik zo, zoniet :
sub <mijn procedure>
start = timer
<<<-Mijn Code->>>
msgbox (timer - start)
end sub

Groeten,
pitufo
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #5 Gepost op: 19 april 2019, 01:39:43 »
Hoi Haije en Pitufo,

Prachtig, kom net thuis van werken en vind deze aangedragen oplossing. Stop werkt idd niet de verbeterde versie werkt prima ga ik eens mee stoeien... Eigenlijk vrij simpel stukje code.


Bedankt allen wederom voor het meedenken en oplossen.

Ps.
Even snel een testje gedaan en bij de oude procedure is de meest uitgebreide optie geklokt op 3,20 seconden (okay er stonden nog een paar getalletjes achter...) en de nieuwe procedure deed dat in ongeveer 2,50 seconden. Er is dus kennelijk nog veel winst te behalen uit mijn code :D
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Procedure snelheid klokken(meten)
« Reactie #6 Gepost op: 19 april 2019, 09:01:37 »
Hey Johan,

Omwille van je laatste vaststellingen heb ik toch even je oude code bekeken (letterlijk bekeken dus, want meer is niet nodig), en ik zie totaal niets dat een langere duur dan hoogstens enkele milliseconden mag geven.
Bijgevolg denk ik dat je massa's formule hebt staan die constant herrekend worden tijdens het uitvoeren van je procedure.
Probeer eens met helemaal vooraan je code te zetten
Application.ScreenUpdating = False
Application.Calculation = xlManual
en als allerlaatste regel
Application.Calculation = xlAutomatic
En laat vooral ook de nieuwe tijdsopname weten  :-\
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #7 Gepost op: 19 april 2019, 11:37:04 »
Dat zou ik kunnen doen waren het niet dat ik dan mank ga op 1 specifieke stukje code, maar dan wel zes keer en dat is het volgnummersysteem, als de eerste groep is geweest dan moet dat nummer bij de volgende regel die binnen die groep past een nummer hebben die met 1 is verhoogt

.Range("B" & B + 1).Value = Sheets("Legenda").Range("D2") + 1

of inde nieuwe code zit dat dan in de array, zodra ik die calculation toevoeg dan krijgen elke groep voor die ene specifieke factuurregel hetzelfde volgnummer De uitslag, in mijn code, ziet er dan ongeveer zo uit:
20190591             I
201990545   UI
20190592             I
201990546   UI
20190593             I
201990547   UI

terwijl met de berekenen uit optie de groep I allemaal hetzelfde volgnummer krijgt, en de groep UI ook

20190594             I
201990548   UI
20190594             I
201990548   UI
20190594             I
201990548   UI

Daarom heb ik dat berekenen dus niet uit staan...
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Procedure snelheid klokken(meten)
« Reactie #8 Gepost op: 19 april 2019, 11:59:57 »
Kan je dat dan niet als volgt opvangen ? (al kan ik niet het ganse plaatje zien i.v.m. I en UI, dus ik ga even uit van I staat in D2

Vooraan in je code de laatst gebruikte zoeken met :
nr_i = Sheets("Legenda").Range("D2") + 1

en verderop
.Range("B" & B + 1).Value = Sheets("Legenda").Range("D2") + 1
vervangen door :
.Range("B" & B + 1).Value = nr_i
nr_i = nr_i + 1

Daarmee kan je weer aan het testen gaan. Maar vergeet niet ook af en toe met de taxi te gaan rijden...
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #9 Gepost op: 19 april 2019, 12:40:30 »
Dit is prachtig pitufo ;)

Ik zal het eens uitgebreid gaan testen vannacht wanneer ik weer uit de auto stap ;)

Superrrrr bedankt voor je input
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #10 Gepost op: 19 april 2019, 14:51:56 »
Eerste resultaat, weliswaar op mijn nieuwe code, geeft na jouw suggestie, pitufo, al een snelheid van de helft van mijn vorige meting... Testen op mijn oude code zal echt even moeten wachten
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Procedure snelheid klokken(meten)
« Reactie #11 Gepost op: 19 april 2019, 17:19:14 »
Hoi Johan,

Dan zit je m.a.w. nog steeds aan meer dan een volle seconde, wat 'afschuwelijk' lang is voor zo een stukje code.
Ik kon het bijgevolg niet laten en heb je code (nog steeds de oude) in een leeg document geplakt, en links en rechts wat waarden ingevuld op de diverse tabbladen zodanig dat ik ze toch werkend kreeg.
Op de koop toe zorgde ik ervoor dat elke mogelijke regel ook wordt uitgevoerd, 't is dus een "gedeelde Schipholrit met fooi en commissie" geworden, met de bedoeling dus om de code zoveel mogelijk 'werk' te geven.
Met screenupdating doet ze er 0,032 seconden over, en zonder 0,014.
De enige voorlopige conclusie luidt dus : "vreemd"

En nu ik toch bezig was ook even naar je 'nieuwe' code gekeken.
Die moet fouten geven, tenzij wat je hier publiceerde ondertussen gecorrigeerd is (?)
Ik zie daar ergens staan
OM = Array(OM1, OM2, OM3, OM6, OM4, OM5)
For ii = 1 To 6
   If OM(ii) = "" Then GoTo Volgende
Het eerste element in een array heeft index 0, dus als ii = 6 zal de code flippen.
Met X = Array... zie ik overigens ongeveer hetzelfde staan.

Los daarvan, maar dat heb ik niet meer getest, moet die ook ongeveer mijn snelheid halen.
Ben dus heel nieuwsgierig hoe het bij jou verder evolueert...

Groeten,
pitufo
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #12 Gepost op: 20 april 2019, 02:47:02 »
Hoi pitufo,

Om met je laatste opmerking te beginnen, ik gebruik de regel bovenaan de macro:
Option Base 1Dat maakt dat ik bij 1 kan beginnen.

De procedure die ik gebruik is een onderdeel van een hele uitgebreide macro/userform. Ik vul in het userform enkele gegevens, tijdsduur en afstand zijn de minimale waardes die ik dien in te voeren, en opties in, ik krijg dan eventueel enkele vragen (hoeveel fooi is er gegeven, met hoeveel wordt de rit gedeeld) druk op de knop Invoeren, dan start de procedure invoeren, die roept op een gegeven moment de procedure "berekenen" aan, dit is een aparte procedure omdat ik ook een herstel optie heb ingebouwd die dezelfde berekenprocedure aan zal roepen, en de combinatie daarvan genereert een factuurregel. dan komt de procedure Jaarjournaal aan bod, en die trekt dus die ene regel uiteen in hapklare brokken zodat ik op een vrij simpele wijze in mijn BTW bestand mijn week, maand en kwartaal overzichten kan genereren.

Nou heb ik het gisteren ook even op mijn werkbestand getest(zonder tijdswaarneming anders wordt je gek na het invoeren van elke rit) en is het zo dat de verwerking sneller is dan dat ik de volgende rit vanuit mijn app voor mij heb, dat was voorheen wel eens trager dus ik ben eigenlijk al meer tevreden dan ik had gehoopt.

Ik wil je best het volledige testbestand sturen, maar dan zal ik het eerst even een stukkie moeten opruimen, en dat gaat er dit paasweekend zeker niet van komen.

Ik heb nu geen puf meer, was een zeer mooie middag/avond om te werken, druk gehad dus nu even ontspannen met een biertje ;)

Wordt vervolgt.
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

Offline pitufo

  • Ambassadeur
  • *****
  • Berichten: 1.343
  • Geslacht: Man
Re: Procedure snelheid klokken(meten)
« Reactie #13 Gepost op: 20 april 2019, 10:27:18 »
Hey Johan,

Option Base 1Correcto  :)

Ik was heus wel mee, hoor, dat die procedure slechts deel was van een veel groter geheel (zo had ik om te testen bv. de ingelezen Me.-elementen moeten omzetten naar werkbladcellen).
In elk geval was het je erom te doen de tijd te bepalen enkel van de meegeleverde procedure, toch ? Anders vergelijken we paaseieren met sinterklaasfiguren (om in de tijdsgeest te blijven...)

Als je het zelf verder zinvol vindt het bestand door te sturen zal ik er graag nog eens naar kijken. Het heeft daarbij geen belang of je motivatie dan mogelijke extra tijdswinst of gewoon Excel-belangstelling is  ;)

By the way, een ganse dag rijden, dan een stuk van de nacht ict-activiteiten, en vervolgens in de drank vliegen... red jij het met 2 uur slaap per nacht ?  0:-)

Groetjes,
pitufo
"De computer doet wel degelijk wat je hem vraagt,
 maar NIET wat je DENKT dat je hem vraagt"

Offline Josc1965

  • Ervaren lid
  • ***
  • Berichten: 279
  • Geslacht: Man
  • Je leert echt wat op "Oplossing.be"
Re: Procedure snelheid klokken(meten)
« Reactie #14 Gepost op: 20 april 2019, 12:03:06 »
Hoi Pitufo,

Idd we hebben het hier puur over deze procedure, en zijn tijdsduur anders had ik in #1 wel anders begonnen en hadden we nu wellicht een veel uitgebreidere boom gehad dan wat het nu is. Mijn eigen intentie is om elke procedure eerst helemaal zelf te doorlopen met mijn steeds meer 'bekwame' VBA skills (wat dat ook mogen betekenen). een van mijn eerste vragen was hier geloof ik hoe krijg ik een waarde die ik op een userform invul op een blad in een cel en van daaruit heb ik als een spons geleerd, en doe dat nog steeds uiteraard, en met veel plezier.

Och ik slaap gewoon 7 a 8 uurtjes, hoef natuurlijk niet om 9 uur op kantoor te zitten, mijn werkdag in het weekend is meestal van 16:00 tot 02:00 (wordt ook wel eens 03:00) dus ik heb als ik wakker word gewoon wat tijd voor mijn hobby en administratie werkzaamheden. Op weekdagen kun je mij gerust lui noemen (2 dagen vrij en de rest 5 a 6 uurtjes werk per dag), lekker met de vrouw shoppen.
Johan
Windows 10 Home   NLD 64bit
Intel(R) Core(TM) i7-7700HQ CPU @ 2.80GHz 2808
838F
Intel(R) HD Graphics 630 1024MB -
NVIDIA Virtual Audio Device (Wave Extensible) (WDM)
C:\ NTFS 118,01GB 44,78GB 8.079MB
AV: Avast Antivirus
FW: Windows Firewal Enabled: True
Office 2016

 


www.combell.com