Roostering

[shugima]

Halllo allemaal,

Ten behoeven van de invoer van roosters in ons systeem zijn wij opzoek naar een oplossing om een visueel rooster om te zetten naar rijdata.
In het bijgevoegde bestand staan twee belangrijke tabbladen: het tabblad blokkenformulier en het tabblad hoofdoverzicht.
Het doel is om op een gemakkelijke wijze de data uit het blokkenformulier om te zetten in bruikbare data in het tabblad hoofdoverzicht.
Het voornamelijke probleem voor mij is, hoe ik de tijd gemakkelijk getransporteerd krijg, zonder dat hierbij handmatige koppelingen dienen te worden gedaan.

als er onduidelijkheden zijn dan geef deze maar aan, ik hoop dat jullie mij verder kunnen helpen en alvast bedankt.

Nick

 

[Elsendoorn2134]

Nick,

Hierbij een macro die je zou kunnen gebruiken om de gegevens over te zetten.

Public Sub LeesUren()
Dim sRecord(5) As Variant
Dim nRegels As Integer
Dim xCell As Range
Dim x As Integer, y As Integer, z As Integer


'Verwijder oude gegevens.
Sheets("Hoofdoverzicht").Range("A2:" & Sheets("Hoofdoverzicht").Range("A2").End(xlDown).End(xlToRight).Address).ClearContents

'Lees blokkenformulier
With Sheets("Blokkenformulier")
    sRecord(2) = .Range("C2")
    sRecord(0) = .Range("J2")
    For x = 0 To 4
        For y = 0 To 46
            With .Range("C5")
                If .Offset(y, x).Value <> "" Then
                    sRecord(1) = .Offset(y, x).Value
                    sRecord(3) = Sheets("Blokkenformulier").Range("A" & Range(.Offset(y, x).Address).Row)
                    Do While .Offset(y, x).Value = sRecord(1)
                        y = y + 1
                    Loop
                    sRecord(4) = Sheets("Blokkenformulier").Range("B" & Range(.Offset(y - 1, x).Address).Row)
                    sRecord(5) = Left(.Offset(-1, x).Value, 2)
                    For z = 0 To 5
                        Sheets("Hoofdoverzicht").Range("A2").Offset(nRegels, z) = sRecord(z)
                    Next z
                    nRegels = nRegels + 1
                End If
            End With
        Next y
    Next x
End With
End Sub

Bekijk bijlage HelpMijRoosterVraag.xlsm

Veel Succes.

 

[shugima]

Heel erg bedankt, dit is iets waarmee ik verder kan werken.
Wat mij betreft is de vraag beantwoord.

 

[Elsendoorn2134]

Shugima,

Dan zou ik zeggen: zet de vraag ook op beantwoord.
Hij staat nu nog op de status "Vraag is niet opgelost".

Elsendoorn2134

 

[shugima]

Beste Elsendoorn of iemand anders,

Ik loop nog tegen een probleem aan. Als ik bijvoorbeeld op donderdag van 14:15 to 14:30 een letter toevoeg (die anders is aan de aansluitende letter A), dan slaat de Macro dit over. Ik heb voor ons uiteindelijk format al veel kunnen aanpassen, maar op dit punt kom ik er niet aan uit.

Aangezien er regelmatig aansluitende lessen zijn, wordt hierdoor de waarde van het bestand eruit gehaald.
In het onderstaande bestand heb ik op de bovenstaande tijd een A toegevoegd, is er een mogelijkheid dat de voorgaande macro dit herkend?

Alvast en nogmaals bedankt.

Nick

Bekijk bijlage Laatset fout.xlsm

 

[Elsendoorn2134]

Nick,

Een kleine aanpassing is voldoende, deze fout ontstaat als je in een For...Next loop de teller (y) handmatig loopt
aan te passen.

Public Sub LeesUren()
Dim sRecord(5) As Variant
Dim nRegels As Integer
Dim xCell As Range
Dim x As Integer, y As Integer, z As Integer


'Verwijder oude gegevens.
Sheets("Hoofdoverzicht").Range("A2:" & Sheets("Hoofdoverzicht").Range("A2").End(xlDown).End(xlToRight).Address).ClearContents

'Lees blokkenformulier
With Sheets("Blokkenformulier")
    sRecord(2) = .Range("C2")
    sRecord(0) = .Range("J2")
    For x = 0 To 4
        For y = 0 To 46
            With .Range("C5")
                If .Offset(y, x).Value <> "" Then
                    sRecord(1) = .Offset(y, x).Value
                    sRecord(3) = Sheets("Blokkenformulier").Range("A" & Range(.Offset(y, x).Address).Row)
                    Do While .Offset(y, x).Value = sRecord(1)
                        y = y + 1
                    Loop
                    y = y - 1
                    sRecord(4) = Sheets("Blokkenformulier").Range("B" & Range(.Offset(y, x).Address).Row)
                    sRecord(5) = Left(.Offset(-1, x).Value, 2)
                    For z = 0 To 5
                        Sheets("Hoofdoverzicht").Range("A2").Offset(nRegels, z) = sRecord(z)
                    Next z
                    nRegels = nRegels + 1
                End If
            End With
        Next y
    Next x
End With
End Sub

Veel Succes

 

[shugima]

En wederom bedankt,

Het leverde nog een probleempje op, namelijk dat het de eindtijd een kwartier terug zet, maar dat valt zelfs met een simpele formule op te lossen.

Lijkt erop dat onze definitieve versie klaar is, nogmaals bedankt.