Urenrooster - Rijen ahankelijk van kolommen

[cloosen]

Hi Kenners,

Zo net voor 2008 heb ik toch nog een probleem waar ik helemaal niet uitkom... :shocked:

Maybe dat iemand van jullie dit al vaker heeft gehad of opgelost, maar ik kan het niet vinden hier op het forum...

Wat ik graag zou willen is dat rijen gevuld worden afhankelijk van de inhoud van kolommen (om intekenlijsten te maken e.d.). En het lukt dus niet... :shocked:

In de bijlage precies zoals ik het resultaat zou willen zien (maar dan handmatig en het zou dus met formules of iets dergelijks moeten kunnen naar mijn idee)...

Als iemand van jullie zin en tijd heeft, helemaal geweldig!!! :thumb: :thumb:

Dank alvast! Gr. Bart

 

[etri]

Als je onderstaande VBA code plakt in de worksheet code van Sheet 1 (Alt+F11 > Alt+R > en dan dubbelklikken op Sheet1 (Blad1) dan wordt automatisch het rooster aangepast als je iets aanpast in je bovenste schema.

Option Explicit

Public Sub VulRooster()
    Dim InputRange As Range
    Dim OutputRange As Range
    Dim iDag As Integer
    Dim iPloeg As Integer
    Dim iTeller As Integer
    Dim iWaarde As Integer
    Dim iAantalKeer As Integer
            
    Set InputRange = Worksheets(1).Range("B4:H8") 'let op: H8 kan varieren?
    Set OutputRange = Worksheets(1).Range("A12:B1000") 'let op: zowel A12 als B1000 kunnen varieren?
    
    'verwijder het onderste rooster (alleen de tekst)
    OutputRange.ClearContents
    
    iTeller = 0
    
    'loop alle dagen langs
    For iDag = 1 To UBound(InputRange.value, 2)
        'loop per dag alle ploegen langs
        For iPloeg = 1 To UBound(InputRange.value, 1)
            iWaarde = InputRange(iPloeg, iDag).value
            
            'Onthoud hoeveel keer een ploeg een dag werkt (?)
            For iAantalKeer = 1 To iWaarde
                'Onthou waar we zijn in het onderste rooster 
                iTeller = iTeller + 1
                
                'bewaar in de resultaten welke ploeg wanneer werkt
                OutputRange(iTeller, 1).value = BepaalDag(iDag)
                OutputRange(iTeller, 2).value = iPloeg

            Next iAantalKeer
        Next iPloeg
    Next iDag

End Sub

Private Function BepaalDag(value As Integer) As String
    Select Case value
        Case 1
            BepaalDag = "ma"
        Case 2
            BepaalDag = "di"
        Case 3
            BepaalDag = "wo"
        Case 4
            BepaalDag = "do"
        Case 5
            BepaalDag = "vr"
        Case 6
            BepaalDag = "za"
        Case 7
            BepaalDag = "zo"
    End Select
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Column >= 2 And Target.Column <= 8) And (Target.Row >= 4 And Target.Row <= 8) Then
        VulRooster
    End If
End Sub

Succes!

 

[etri]

Ook maar even de sheet zelf met de code... Scheelt je weer overtikken

 

[cloosen]

:thumb: Amazing! Wat goed..! :thumb:

Ik ben je echt mega dankbaar; ik kan weer verder klussen!! Super!!! :thumb::thumb:

 

[Wigi]

Hoi

een korter alternatief voor BepaalDag:

Private Function BepaalDag(value As Integer) As String

    BepaalDag = Format(DateSerial(1, 1, value), "ddd")

End Function

Wigi

 

[etri]

Wigi: ik heb hier wel aan gedacht, maar de uitkomst kan dan in het engels zijn als je instelling/windowsversie Engels is. Dan krijg je "mon", tue" etc. Maar het is wel netter idd!

 

[Wigi]

Wigi: ik heb hier wel aan gedacht, maar de uitkomst kan dan in het engels zijn als je instelling/windowsversie Engels is. Dan krijg je "mon", tue" etc. Maar het is wel netter idd!

Ah OK, zo wel ja. De Windows taal is hier vermoedelijk bepalend.

Wigi

 

[ReneDirks]

Wil je 'm dan toch korter hebben:

Public Function BepaalDag(iNumDay As Integer) As String
    Const strDays As String = "madiwodovrzazo"
    
    BepaalDag = Mid(strDays, 1 + (iNumDay - 1) * 2, 2)
End Function

Kun je 'm ook nog snel vertalen naar andere talen

 

[cloosen]

Dat is inderdaad het handigste (ik gebruik bijvoorbeeld zowel een Nederlandse desktop en een Engelse laptop zeg maar). Veel dank aan jullie!! :thumb::thumb: