Complexe formule naar VBA

jkpieterse · 23 jul 2018

Goto gebruik wordt gezien als "bad practise". Je kan dit deel:

Code:

Stap1:
    dt1 = dt1 - 1: wd = Weekday(dt1, vbMonday)
    If Mid(Week_Patroon, wd, 1) = "1" Then GoTo Stap1
    If WorksheetFunction.CountIf(Holidays, Int(dt1)) > 0 Then GoTo Stap1

herschrijven tot:

Code:

        Do
            dt1 = dt1 - 1
            wd = Weekday(dt1, vbMonday)
        Loop Until WorksheetFunction.CountIf(Holidays, Int(dt1)) <= 0 Or Mid(Week_Patroon, wd, 1) <> "1"

Ook bad practise: gegevens direct opvragen uit cellen in de UDF. De regel is eigenlijk dat je alle gegevens die een functie nodig heeft doorgeeft via de argumenten van de functie en dus als celverwijzingen.

Piet Bom · 23 jul 2018

@jkpieterse,
Bedankt voor de tips.

Eigenlijk wist ik het wel, maar bij het maken van een draft denk ik nog niet over die dingen.

Maar bij de optimalisatie slag, komen die dingen wel aan bod.
Helaas voor mij is dat wel de lange weg.
Ik heb inmiddels al getest met mijn draft versie, dus kan binnenkort feedback geven.
Betekent: Bad Practise, slechtere performance of gewoon niet fraai programmeren ?
Ik heb inmiddels nagedacht over de zoekroutine naar Holidays. Die lijkt me veel processor-tijd te kosten.
Ik had het volgende idee:
1. Ik maak een button op sheet Holidays
2. De button voert een macro uit die een soort Index-array creëert op sheet: FD_Index
3. Iedere holiday is een getal van het aantal dagen na 1-jan-1900
4. Zet een 1 in kolom A op regel dag-getal (vandaag 23-juli-2018 is 43304 )
5. Bij het uitvoeren laad je deze index in een array (as variant)
6. in de VBA hoef je niet meer te loop-en door de holidays, maar je checkt direct of Array(dag-getal, 1) = 1
7. Zo ja dan is die datum een feestdag.
8. Wat ik nog niet weet is hoe lang het duurt om een lange range in te laden in een array.
9. Mocht dat een probleem zijn dan kun je dat reduceren door met een offset van 30000 te werken.
Affijn, nog veel te testen.
Ik doe ze 1 voor 1 dan hoop ik te ontdekken welke aanpassing het meeste winst oplevert

to be continued……….

jkpieterse · 23 jul 2018

Vooral niet fraai programmeren (en daardoor vaak slecht te volgen en te onderhouden). Best practises voeren vaak tot eindeloze discussies, omdat er nou eenmaal meerdere wegen naar Rome leiden. Zo vinden de meeste VBA programmeurs dat je je variabelen dient te declareren en dat je begrijpelijke variabele namen moet gebruiken. Niet iedereen vindt dat ook.

Piet Bom · 6 aug 2018

Ik heb een aantal tips overgenomen en toegepast.
Het werkt nu zoals ik wilde.
Met een snelle zoekroutine om feestdagen te checken (via reeks: FD_Indeks)
De GoTo StapX heb ik deels vervangen door: Do Until, en moet toegeven dat dat er beter uitziet. (nu moeten mijn oude hersenen er nog aan wennen

)
In de bijlage vindt je mijn testbestand met wat oefenmateriaal.
Nogmaals Bedankt Helpers, dank zij jullie kan ik weer iets van mijn Bucket-List afstrepen

snb · 10 aug 2018

Ola Piet,

Om je oude hersenen nog maar eens pijnigen een suggestie vanuit mijn (jonge

) hersenpan.

Als ik goed begrijp wat je wil moet je uitgaan van de volgende gegevens:
- een einddatum met eindtijd
- een doorlooptijd
- een begintijd op iedere werkdag
- een eindtijd op iedere werkdag
- het aantal arbeidsuren per werkdag (= eindtijd - begintijd)
- een overzicht van feestdagen

Jij hebt nu alle 'feest'dagen in een tabel staan.
Omdat die niet flexibel zijn zou het eenvoudiger zijn daarvan met een macro een tekstreeks te maken.
Dat heb ik in de ondertaande macro nog niet gedaan.
Maar het is natuurlijk niet efficiënt om iedere keer opnieuw bij het draaien van de macro de tabel met feestdagen om te zetten in een tekstreeks.

Ik heb voor je een macro gemaakt om vanuit een einddatum en eindtijd op basis van een doorlooptijd (in uren en minuten) een begindatum en begintijd te berekenen.

Zo gauw je deze in de vingers hebt (of tussen de oren), is via dezelfde systematiek de inverse (van begindatum en begintijd en doorlooptijd de einddatum en einddtijd berekenen) een fluitje van een cent.

Voor de eenvoud berekent de onderstaande macro 1 einddatum.
In cel A1 staat de eindtijd (datum + tijd).
In cel B1 staat de doorlooptijd
In cel C1 komt de begintijd (datum +tijd) te staan

Code:

Sub M_snb_van_eind_naar_begindatum()
[COLOR="#008000"]'   sn(0): einddatum + eindtijd ; assumptie: niet in weekend of feestdag
'   sn(1): doorlooptijd
'   sn(2): starttijd per dag : 1/3 =08:00 uur
'   sn(3): arbeidsuren per dag: 1/3 = 8 uur
'   sn(4): feestdagen
'   sn(5): arbeidsuren
'   sn(6): begindatum[/COLOR]

   sn = Array(Sheet1.Cells(1, 1), Sheet1.Cells(1, 2), 1 / 3, 1 / 3, Join(Application.Transpose(Sheet2.Columns(1).SpecialCells(2, 1)), "|"), 0, 0, 0)
   
   sn(5) = sn(0) - sn(2) - Int(sn(0))      [COLOR="#008000"] '  arbeidsuren op de laatste dag[/COLOR]
   
   If sn(5) > sn(1) Then                   [COLOR="#008000"] '  doorlooptijd  <  aantal arbeidsuren op de laatste dag[/COLOR]
      sn(6) = sn(0) - sn(1)
   Else
       sn(6) = Int(sn(0))
       Do
         sn(6) = sn(6) - 1                 [COLOR="#008000"] ' ga naar de vorige dag[/COLOR]
         If InStr(sn(4), "|" & 1 * sn(6) & "|") = 0 And Weekday(sn(6), 2) < 6 Then sn(5) = sn(5) + sn(3)  [COLOR="#008000"] '  als werkdag: verhoog arbeidsuren met arbeidsuren per dag[/COLOR]
       Loop Until sn(5) > sn(1)
       
       sn(6) = sn(6) + sn(2) + sn(3) - (sn(1) - (sn(5) - sn(3)))
   End If
   
   Sheet1.Cells(1, 3) = sn(6)
End Sub

snb · 11 aug 2018

Ik ben nog even aan het prusten geweest.
In de vorige bijlage stond nog een foute verwijzing naar blad1.

In de nieuwe bijlage:

De feestdagen zijn als tekstreeks geconcentreerd in sheet3 cel C1.
De macro daarvoor staat in de Codemoduel van Sheet3.

De code van sheet1 staat in de workbook_change gebeurtenis.

De code voor de berekening van een range staat in de codemodule van Sheet2.

De precisie is uitgebreid naar sekondennivo.
Om het decimaalprobleem van Excel te vermijden is gebruik gemaakt van DateAdd en DateDiff.

Piet Bom · 11 aug 2018

Hoi snb,
Bedankt voor de moeite die je hebt genomen om mijn topic nog verder te completeren.
Momenteel ben ik nogal druk met mijn andere Excel-projecten.
Maar morgen duik ik er even in en laat dan nog van me horen.

Piet Bom · 12 aug 2018

@snb,
Na de uitgebreide test kom ik tot de conclusie dat jouw compacte code goed werkt.
Ik durf het bijna niet te vragen, maar doe het toch maar:
Als de einddatum per ongeluk op een niet-werkdag valt, zou hij toch de goede uitkomst moeten geven.
Je zou eerst moeten checken of de einddatum op een werkdag valt.
Zo niet, dan met een Do-Loop steeds 1 dag eraf trekken tot dat je op een werkdag belandt.
En dan wordt je nieuwe einddatum die dag om 16:00u
Daarna kan de huidige routine gewoon worden uitgevoerd.
Ik ga het zelf eerst proberen, maar een TS mag toch gewoon vragen stellen ?

Piet Bom · 12 aug 2018

De code als volgt aangepast:
En het lijkt te werken

Code:

Sub M_snb_van_eind_naar_begindatum_range()
'   sn(0): einddatum + eindtijd ; assumptie: [COLOR="#FF0000"]mag ook op niet-werkdag vallen[/COLOR]
'   sn(1): doorlooptijd
'   sn(2): starttijd per dag : 08:00 uur =28800 sekonden
'   sn(3): arbeidsuren per dag: 8 uur = 28800 sekonden
'   sn(4): feestdagen
'   sn(5): gecumuleerde arbeidsuren
'   sn(6): begindatum

   sn = Array(0, 0, 28800, 28800, Sheet3.Cells(1, 3), 0, 0, 0)
   sp = Sheet2.Cells(1).CurrentRegion
   
   For j = 1 To UBound(sp)
        sn(0) = sp(j, 3)
[COLOR="#FF0000"]'--------------------------------------------------------------------------------------
        If InStr(sn(4), "|" & 1 * sn(0) & "|") = 1 Or Weekday(sn(0), 2) > 5 Then
          sn(0) = Fix(sn(0)) + ((sn(2) + sn(3)) / 86400) + 1
          Do
            sn(0) = sn(0) - 1
            Loop Until InStr(sn(4), "|" & 1 * sn(0) & "|") = 0 And Weekday(sn(0), 2) < 6
        End If
'---------------------------------------------------------------------------------------[/COLOR]
        sn(1) = sp(j, 2) * 86400
        sn(5) = DateDiff("s", DateAdd("s", sn(2), Fix(sn(0))), sn(0)) '  arbeidsuren op de laatste dag
        
        If sn(5) >= sn(1) Then                       '  doorlooptijd  <  aantal arbeidsuren op de laatste dag
           sp(j, 1) = DateAdd("s", -sn(1), sn(0))
        Else
            sn(6) = Fix(sn(0))
            Do
             sn(6) = sn(6) - 1                           ' ga naar de vorige dag
             If InStr(sn(4), "|" & 1 * sn(6) & "|") = 0 And Weekday(sn(6), 2) < 6 Then sn(5) = sn(5) + sn(3)   '  als werkdag: verhoog arbeidsuren met arbeidsuren per dag
            Loop Until sn(5) >= sn(1)
            
            sp(j, 1) = DateAdd("s", sn(2) + sn(3) - (sn(1) - (sn(5) - sn(3))), sn(6))
        End If
   Next
   
   Sheet2.Cells(1, 5).Resize(UBound(sp), 1) = sp
End Sub

snb · 12 aug 2018

Ik ben eerst nog bezig de van einddatum naar begindatum en de van begindatum naar einddatum in 1 funktie te integreren.

Zag je dat er 1 verschil was tussen jouw uitkomsten van de range met jouw aanpak en de mijne ?

snb · 12 aug 2018

Ik ben eerst nog bezig de van einddatum naar begindatum en de van begindatum naar einddatum in 1 funktie te integreren.

Zag je dat er 1 verschil was tussen jouw uitkomsten van de range met jouw aanpak en de mijne ?

Piet Bom · 12 aug 2018

snb zei:
Zag je dat er 1 verschil was tussen jouw uitkomsten van de range met jouw aanpak en de mijne ?

Ja, in mijn versie 3 zat inderdaad nog een fout, ik heb nu inmiddels versie 4 en die doet het goed, net als jouw oplossing.
Jouw code is veel korter en overzichtelijker, dus die wil ik adopteren.
Ik heb wel functions gemaakt omdat die beter zijn te gebruiken in een planning waar de 3 varianten willekeurig voorkomen:
1. Forward calculation (van startdatum via doorlooptijd naar de einddatum rekenen)
2. Backward calculation ( van einddatum via doorlooptijd naar startdatum rekenen)
3. Doorlooptijd berekenen tussen startdatum en einddatum.
Dus jouw activiteit om de Forward en Backward calculation in 1 funktie te combineren past precies in mijn plan

Hierbij nog even mijn versie 4 function: (die het wel doet, maar die ik wil gaan skippen, omdat hij te lang en onoverzichtelijk is.)

Code:

Function Calc_StartDate_INTL4[COLOR="#FF0000"][/COLOR](fin As Double, dur As Double, Week_Patroon As String, holidees As Range, SF_flag As String, STime As Double, FTime As Double) As Double
  Dim sec_1 As Double, sec_1000ste As Double, dt1 As Double, wd As Integer, sfflg As Integer, OfSet As Long
  Dim du1 As Double, Old_dt1 As Double, i As Long
  sec_1 = 1 / 24 / 60 / 60
  sec_1000ste = sec_1 / 1000
  fin = Int(fin / sec_1 + 0.5) * sec_1 'afronden op hele seconde
  dur = Int(dur / sec_1 + 0.5) * sec_1 'afronden op hele seconde
  If dur < 0 Then GoTo uit1
  If STime >= FTime Then GoTo uit1
  If SF_flag <> "S" And SF_flag <> "F" Then SF_flag = "F"
  sfflg = 1: If SF_flag <> "F" Then sfflg = -1
  OfSet = 35000
  dt1 = fin
  wd = Weekday(dt1, vbMonday)
  du1 = 0
'------------------------------------------------------stap-1
  If dur = 0 Then GoTo uit1
'------------------------------------------------------stap0
  If dt1 >= Int(dt1) + FTime Then dt1 = Int(dt1) + FTime
'------------------------------------------------------stap1
  If dt1 < Int(dt1) + STime Or Mid(Week_Patroon, wd, 1) = "1" Or holidees(Int(dt1) - OfSet, 1) = 1 Then
    Do
      dt1 = dt1 - 1: wd = Weekday(dt1, vbMonday)
    Loop Until Mid(Week_Patroon, wd, 1) = "0" And holidees(Int(dt1) - OfSet, 1) <> 1
    dt1 = Int(dt1) + FTime
  End If
'------------------------------------------------------stap2
  If dt1 >= Int(dt1) + STime Then
    dt1 = dt1 + 1
    Do
      dt1 = dt1 - 1: wd = Weekday(dt1, vbMonday)
    Loop Until Mid(Week_Patroon, wd, 1) = "0" And holidees(Int(dt1) - OfSet, 1) <> 1
    Old_dt1 = dt1
    dt1 = Int(dt1) + STime
    du1 = du1 + (Old_dt1 - dt1): du1 = Int(du1 / sec_1 + 0.5) * sec_1
    If du1 >= (dur + sfflg * sec_1000ste) Then dt1 = dt1 + (du1 - dur): GoTo uit1
  End If
'------------------------------------------------------stap3
Stap3:
  Do
    dt1 = dt1 - 1: wd = Weekday(dt1, vbMonday)
  Loop Until Mid(Week_Patroon, wd, 1) = "0" And holidees(Int(dt1) - OfSet, 1) <> 1
  du1 = du1 + FTime - STime: du1 = Int(du1 / sec_1 + 0.5) * sec_1
  If du1 >= (dur + sfflg * sec_1000ste) Then dt1 = dt1 + (du1 - dur): GoTo uit1
  GoTo Stap3
uit1:
  Calc_StartDate_INTL[COLOR="#FF0000"]4[/COLOR] = Int(dt1 / sec_1 + 0.5) * sec_1
End Function

snb · 12 aug 2018

Ik heb de einddatum cq. begindatum op een feestdag of in het weekend toegevoegd.

Ik maak bij voorkeur geen gebruik van een UDF, omdat die te vaak overbodig herberekent; zelfs iedere keer als in een ander geopend werkboek iets verandert.

De funktie staat in de macromodule van 'ThisWorkbook'.
De aanroepende macro staat in de macromodule van het werkblad die de gegevens bevat die de basis zijn voor de berekening en waarin ook het resultaat van de berekening terecht moet komen.

Ik denk dat het algoritme nog wel vereenvoudigd kan worden.
Maar dat is van later zorg.
Eerst maar eens die doorlooptijdberekening.

NB. Strikt genomen duurt een 8-urige werkdag niet van 08:00 uur tot 16:00 uur maar tot en met 15.59 uur

snb · 13 aug 2018

Ik geloof/hoop dat dit de definitieve versie is:

Piet Bom · 13 aug 2018

@snb,
Ze werken alle 3 bijna perfect.
Het zit hem in die afwijking van 1 seconde.
Je vraag je af waar gaat het over.
Het is inderdaad niet nodig om op de seconde nauwkeurig te rekenen.
Maar als je het resultaat op 5 seconde afrondt, dan geeft hij de exacte resultaten.
In een plannings-reeks van 20 activiteiten, kan de afwijking oplopen naar 20 seconde.
Dat is nog niet veel, maar staat slordig als de uitkomsten op uu:mm:ss wordt weergegeven.
Bij mijn voorstel om af te ronden op 5 seconden, heb je die kettingreactie niet.
In de bijlage heb ik wat nieuwe testdata geplakt.
Ik ben al heel gelukkig met jouw routines, ze werken snel en zijn nog steeds heel compact.

snb · 14 aug 2018

@Piet

Ik heb nog niet naar jouw bestand gekeken, maar

- de routines vereenvoudigd (wat toch weer kon !)
- een poging gedaan met Excel-formules hetzelfde resultaat te krijgen.

- de Excelformule voor de doorlooptijd komt exact overeen met het VBA-resultaat.
- de Excelformules voor de begintijd, resp. de eindtijd geeft bij het weekend afwijkende resultaten; voor de rest werkt hij/zij ook 'perfekt'.

Zie de bijlage

snb · 16 aug 2018

Nu met goedwerkende Excelformules (althans bij deze gegevens)

Piet Bom · 16 aug 2018

@snb,
Geweldige service, man !
Ik ga er zo snel mogelijk naar kijken.
to be continued……..

Piet Bom · 18 aug 2018

Hoi snb,
Ik heb er naar gekeken, maar niet precies begrepen hoe het werkt.
In de bijlage heb ik wat testdata geplakt, en nu gaan er een stel resultaten niet goed.
Waarschijnlijk doe ik iets fout, maar zie niet zo gauw wat.
We gaan toch nog steeds uit van een 5-daagse werkweek, met werktijden van 08:00u tot 16:00u en verder de normale nationale feestdagen ?

snb · 20 aug 2018

Ha Piet,

Helaas doe jij niets fout.

Het ligt dus aan mijn formules.

In de bijlage mijn nieuwe oplossing.
Ik heb me geconcentreerd op de formules; de VBA-aanpak heb ik maar gelaten voor wat ie was.
Laat maar horen of je ook die kunt torpederen.

Complexe formule naar VBA

Terugkerende gebruiker

Verenigingslid

Terugkerende gebruiker

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Verenigingslid

Verenigingslid

Verenigingslid

Verenigingslid

Verenigingslid

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Verenigingslid

Verenigingslid

Bijlagen

Verenigingslid

Bijlagen

Wij waarderen jouw privacy