• 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.

dienstrooster in VBA

Status
Niet open voor verdere reacties.

Efsix

Gebruiker
Lid geworden
14 jan 2007
Berichten
181
kan iemand mij behulpzaam zijn bij het ombouwen van een VBA script? Ik heb een script voor een 10 daagse cyclus van 5 ploegen volgens het 2-2-2 principe.
Bij het ombouwen naar een ander rooster met een regelmaat van 35 dagen loop ik vast.

Op de één of anderen manier krijg ik het bestaande script niet verder uitgebreid dan 10.

De cyclus zou moeten worden;
mo,mo,mo,mo,vrij,vrij,mi,mi,mi,vrij,vrij, na,na,na,na,vrij,vrij,vrij, mo,mo,mo,vrij,vrij,mi,mi,mi,mi,vrij,vrij,na,na,na,vrij,vrij,vrij.


Hier is het VBA script voor een cyclus van 10 dagen.

'*-----------------------
'*Input* * *:=DatumX + PloegX
'*Output* * :=Naam van dienst ("1e ochtend","2e vrij"....)
'*---------------------------------------------------------
Dim fdat As Date
Dim fact As Double
Dim convFact As String
Dim Dienst As String
Select Case Ploeg
Case "A"
fdat = #10/18/2004#
Case "B"
fdat = #10/20/2004#
Case "C"
fdat = #10/22/2004#
Case "D"
fdat = #10/24/2004#
Case "E"
fdat = #10/26/2004#
End Select
fact = (MyDate - fdat) / 10
convFact = CStr(fact)
If InStr(convFact, ",") = 0 Then
* * Dienst = "1e Ochtend"
Else
* * Select Case Right(convFact, 1)
* * Case 1
* * * Dienst = "2e Ochtend"
* * Case 2
* * * Dienst = "1e Middag"
* * Case 3
* * * Dienst = "2e Middag"
* * Case 4
* * * Dienst = "1 Nacht"
* * Case 5
* * * Dienst = "2e Nacht"
* * Case 6
* * * Dienst = "1 vrij"
* * Case 7
* * * Dienst = "2e vrij"
* * Case 8
* * * Dienst = "3e vrij"
* * Case 9
* * * Dienst = "4e vrij"
* * End Select
*End If
*DienstFromDate = Dienst
End Function




groeten, Romé
 
mijn script

hier is mijn script dat maar niet wil werken.



'*-----------------------
'*Input :=DatumX + PloegX
'*Output :=Naam van dienst
'*---------------------------------------------------------
Dim fdat As Date
Dim fact As Double
Dim convFact As String
Dim Dienst As String
Select Case Ploeg
Case "ploeg A"
fdat = #1/1/2007#
Case "ploeg B"
fdat = #1/8/2007#
Case "ploeg C"
fdat = #1/15/2007#
Case "ploeg D"
fdat = #1/22/2007#
Case "ploeg E"
fdat = #1/29/2007#
End Select
fact = (MyDate - fdat) / 30
convFact = CStr(fact)
If InStr(convFact, ",") = 0 Then
Dienst = "Mo"
Else
Select Case Right(convFact, 1)
Case 1
Dienst = "Mo"
Case 2
Dienst = "Mo"
Case 3
Dienst = "Mo"
Case 4
Dienst = "Mo"
Case 5
Dienst = "-"
Case 6
Dienst = "-"
Case 7
Dienst = "Mi"
Case 8
Dienst = "Mi"
Case 9
Dienst = "Mi"
Case 10
Dienst = "-"
Case 11
Dienst = "-"
Case 12
Dienst = "Na"
Case 13
Dienst = "Na"
Case 14
Dienst = "Na"
Case 15
Dienst = "Na"
Case 16
Dienst = "-"
Case 17
Dienst = "-"
Case 18
Dienst = "-"
Case 19
Dienst = "Mo"
Case 20
Dienst = "Mo"
Case 21
Dienst = "Mo"
Case 22
Dienst = "-"
Case 23
Dienst = "-"
Case 24
Dienst = "Mi"
Case 25
Dienst = "Mi"
Case 26
Dienst = "Mi"
Case 27
Dienst = "Mi"
Case 28
Dienst = "-"
Case 29
Dienst = "-"
Case 30
Dienst = "Na"
Case 31
Dienst = "Na"
Case 32
Dienst = "Na"
Case 33
Dienst = "-"
Case 34
Dienst = "-"
Case 35
Dienst = "-"
End Select
End If
DienstFromDate = Dienst
End Function
 
bestand bijgevoegd

misschien toch handiger als ik mijn eigen knutsel mee stuur :-)
 
de reden waarom je niet verder kan komen dan is het feit dat je alleen de laatste letter uit de string haalt
Select Case Right(convFact, 1)
Dan kom je natuurlijk niet verder dan van 0-9:)
Verder zou het handig zijn als je de letter zou omzetten in een getal met val(string)
In de de select case kun je dan gelijke diensten samentrekken
case 1 to 3
= jouw dienst enz.
en als laatste tip. objecten werken niet altijd als je de klasse niet ook benoemd (persoonlijk veel gekl**t mee gehad.
strings.right(string) is daarom bedrijfszekerder.
mvg leo
ps zit op mn werk, ben dus al aan t spijbelen, kan het dus niet verder uitwerken.
 
Laatst bewerkt:
de reden waarom je niet verder kan komen dan is het feit dat je alleen de laatste letter uit de string haalt
Select Case Right(convFact, 1)
Dan kom je natuurlijk niet verder dan van 0-9:)
Verder zou het handig zijn als je de letter zou omzetten in een getal met val(string)
In de de select case kun je dan gelijke diensten samentrekken
case 1 to 3
= jouw dienst enz.
en als laatste tip. objecten werken niet altijd als je de klasse niet ook benoemd (persoonlijk veel gekl**t mee gehad.
strings.right(string) is daarom bedrijfszekerder.
mvg leo
ps zit op mn werk, ben dus al aan t spijbelen, kan het dus niet verder uitwerken.


Beste Leo,
Ik probeer jouw hints te vatten, maar ik realiseer me dat ik niet voor niks een junior lid ben:o
 
Oké ik doe misschien ook te veel te gelijk.
ik ben zelf ook door schade en scahnde aan het wijs worden en leer nog dagelijks bij.
(dat klinkt lekker trouwens:p)
Heb je het verhaal van de right string wel begrepen, je hebt daar twee getallen nodig.

Begrijp ik trouwens goed dat een werkdag naast "de lat"van 35 op een volgende werkdagen wilt leggen en zo uit wil rekenen welke dienst bij welke datum hoort.
Dus dienst x komt na bv 10 dagen, dan weer naar 45 dagen en dan weer 35 + 35 dagen enz. en dan 5 verschillenden "latten"van 35 dagen voor 5 ploegen.
Wanneer dit klopt en je er met de verandering van right string naar
Select Case Right(convFact, 2) niet uitkomt, dan kan ik een voorstelletje proberen te maken wat bovenstaande doet.
mvg leo
 
Kon het niet laten, was toch al aan het knutselen.
Ik kom hier op uit.
Ik heb er een paar message boxen tussen gezet ter controle.
Laat het even weten wanneer het niet is wat je bedoelt,
of wanneer je foute diensten eruit krijgt.
(even knippen en plakken in een leeg project om te testen)
mvg leo
Code:
Function diensten()
'*-----------------------
'*Input :=DatumX + PloegX
'*Output :=Naam van dienst
'*---------------------------------------------------------
Dim mydate As Date
Dim dienstfromdate As String
Dim ploeg As String
'deze drie even zelf gedeclareerd

'test waardes deze steeds veranderen
mydate = #2/26/2007#
ploeg = "ploeg A"


Dim fdat As Date
Dim fact As Double
Dim dienst As String
Dim dagen As Integer


Select Case ploeg
Case "ploeg A"
    fdat = #1/2/2007#
Case "ploeg B"
    fdat = #1/8/2007#
Case "ploeg C"
    fdat = #1/15/2007#
Case "ploeg D"
    fdat = #1/22/2007#
Case "ploeg E"
    fdat = #1/29/2007#
End Select

dagen = mydate - fdat
If dagen > 34 Then
'mod rekent de rest van het aantal dagen uit gedeeld door zoveel keer 35 als nodig is.
MsgBox (dagen & "= aantal dagen tussen" & fdat & " & " & mydate)
dagen = dagen Mod 35
MsgBox ("=rest dagen wanneer je door X maal door 35 deelt" & dagen)

End If
'let op de telling begint nu bij 0!
Select Case dagen
Case 0 To 3
    dienst = "Mo"
Case 4 To 5
    dienst = "-"
Case 6 To 8
    dienst = "Mi"
Case 9 To 10
    dienst = "-"
Case 11 To 14
    dienst = "Na"
Case 15 To 17
    dienst = "-"
Case 18 To 20
    dienst = "Mo"
Case 21 To 22
    dienst = "-"
Case 23 To 26
    dienst = "Mi"
Case 27 To 28
    dienst = "-"
Case 29 To 31
    dienst = "Na"
Case 32 To 34
    dienst = "-"
End Select

dienstfromdate = dienst
MsgBox ("dienst=" & dienst)
End Function
 
Kon het niet laten, was toch al aan het knutselen.
Ik kom hier op uit.
Ik heb er een paar message boxen tussen gezet ter controle.
Laat het even weten wanneer het niet is wat je bedoelt,
of wanneer je foute diensten eruit krijgt.
(even knippen en plakken in een leeg project om te testen)
mvg leo
Code:
Function diensten()
'*-----------------------
'*Input :=DatumX + PloegX
'*Output :=Naam van dienst
'*---------------------------------------------------------
Dim mydate As Date
Dim dienstfromdate As String
Dim ploeg As String
'deze drie even zelf gedeclareerd

'test waardes deze steeds veranderen
mydate = #2/26/2007#
ploeg = "ploeg A"


Dim fdat As Date
Dim fact As Double
Dim dienst As String
Dim dagen As Integer


Select Case ploeg
Case "ploeg A"
    fdat = #1/2/2007#
Case "ploeg B"
    fdat = #1/8/2007#
Case "ploeg C"
    fdat = #1/15/2007#
Case "ploeg D"
    fdat = #1/22/2007#
Case "ploeg E"
    fdat = #1/29/2007#
End Select

dagen = mydate - fdat
If dagen > 34 Then
'mod rekent de rest van het aantal dagen uit gedeeld door zoveel keer 35 als nodig is.
MsgBox (dagen & "= aantal dagen tussen" & fdat & " & " & mydate)
dagen = dagen Mod 35
MsgBox ("=rest dagen wanneer je door X maal door 35 deelt" & dagen)

End If
'let op de telling begint nu bij 0!
Select Case dagen
Case 0 To 3
    dienst = "Mo"
Case 4 To 5
    dienst = "-"
Case 6 To 8
    dienst = "Mi"
Case 9 To 10
    dienst = "-"
Case 11 To 14
    dienst = "Na"
Case 15 To 17
    dienst = "-"
Case 18 To 20
    dienst = "Mo"
Case 21 To 22
    dienst = "-"
Case 23 To 26
    dienst = "Mi"
Case 27 To 28
    dienst = "-"
Case 29 To 31
    dienst = "Na"
Case 32 To 34
    dienst = "-"
End Select

dienstfromdate = dienst
MsgBox ("dienst=" & dienst)
End Function

Leo,

Het ziet er indrukwekkend uit. Ik ben je script aan het testen. Volgens mij snap je precies wat ik bedoel. :-)
Mijn bedoeling is om op basis van 2 variabelen ( n.l. datum en ploegnaam) een dienst tabel / lijst / kalender te genereren.
Ga nu kijken of ik met mijn 'ahum' :D kennis met jouw script uit de voeten kan.
Ik laat weten of ik er uit kom. thnxxx
 
Leo Bedankt !!

Leo,

Het ziet er indrukwekkend uit. Ik ben je script aan het testen. Volgens mij snap je precies wat ik bedoel. :-)
Mijn bedoeling is om op basis van 2 variabelen ( n.l. datum en ploegnaam) een dienst tabel / lijst / kalender te genereren.
Ga nu kijken of ik met mijn 'ahum' :D kennis met jouw script uit de voeten kan.
Ik laat weten of ik er uit kom. thnxxx


Leo,
Ik heb je script aan de 'praat' :D Precies zoals ik bedoelde kan ik nu allerlei roostertoepassingen met Excel maken.
Het enige dat me nog te doen staat is het script zodanig 'fijn-tunen' dat het exact parallel loopt met ons huidige dienstrooster.

Hartelijk bedankt !!
Groeten, Romé
 
Mooi,
Volgens mij zit jij ook te werken in je vrij tijd:)
Of heb je avonddienst oid.
mvg leo
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan