Automatiseren van Jaarplanning in Excel

[GENL]

Beste Allen,

voor mijn werk ben ik een excel bestand aan het maken met examens erin. Dit betreft een sheet van zo'n 500 rijen.
mijn eerste tabblad (examen) bestaat uit filters waardoor ik alles netjes op datum, klas, opleiding etc. kan rangschikken. Vanuit dit tabblad wil ik per opleiding een jaarplanning maken.
(deze jaarplanning wordt als PDF gedeeld met de leerlingen)

Omdat ik mijn vorig jaar er niet goed in heb kunnen verdiepen doe ik dit nu allemaal handmatig, een vreselijk karwei aangezien data van examens regelmatig wijzigen en ik dit alles handmatig doorvoer.

In de bijlage een anoniem voorbeeld bestand:
Bij het tabblad opleiding 3 > worden de data automatisch ingevuld die hierbij horen (vanuit de geel gekleurde kolommen). Bijv. op 23/11 onder het tablad opleiding 3 komt in de cel: H- 4de jaars - EXAMEN 1
(dit tot een max. van 3 examens per data, een voorbeeld zonder cordering zie je in VB > opleiding 3)

Is er iemand die mij kan helpen om dit te automatiseren?
Alvast bedankt.

 

[VenA]

Je kan er een macro voor gebruiken. De feestdagen en vakanties verdwijnen wel maar is met een betere opzet ook nog wel te voorkomen.

Sub VenA()
  ar = Sheets("examens").Cells(1).CurrentRegion
  For Each sh In Sheets(Array("opleiding 1", "opleiding 2", "opleiding 3"))
    sh.Range("C3:E47,H3:J47,M3:O47,R3:T47,W3:Y47").ClearContents
  Next sh

  For j = 2 To UBound(ar)
    With Sheets(ar(j, 2))
      ar1 = .Cells(1).CurrentRegion
      For jj = 2 To UBound(ar1)
        For jjj = 2 To UBound(ar1, 2) Step 5
          If ar(j, 13) = ar1(jj, jjj) Then
            Set r = .Cells(jj, jjj)
            x = Application.CountA(r.Resize(, 4))
            If x > 3 Then
              c00 = c00 & ar(j, 2) & " " & Format(ar(j, 13), "dd-mm-yyyy") & vbLf
             Else
              r.Offset(, x) = ar(j, 3) & " " & ar(j, 5) & " " & ar(j, 6)
            End If
          End If
        Next jjj
      Next jj
    End With
  Next j
  If Len(c00) Then MsgBox "niet alles verwerkt" & vbLf & c00
End Sub

 

[cow18]

de schrik van iedere VBA-er, samengevoegde cellen
zoiets

 

[VenA]

@cow18,

dd = Format(CLng(CDate(a(i, 13))), "d/m")
Set c = .Find(dd, LookIn:=xlValues)

Je wil niet weten hoeveel pogingen ik gedaan heb om het met .find aan de praat te krijgen. Ook met jouw code werkt het bij mij niet. Tenzij het de bedoeling is dat ik 14 berichten mag wegklikken
Dus daarom maar gekozen voor een extra array.

 

[HSV]

Beter?

dd = Format(a(i, 13), "dd\/mm")  'vertaal je datum in het goeie format
            Set c = .Find(dd, , , xlWhole) 'zoek die datum

 

[GENL]

Beste Allen, ten eerste bedankt voor alle hulp.

@VenA Als ik de macro in mijn testbestandje zet doet hij het, inderdaad de vakanties vallen weg, maar dat is geen grote ramp.
Omzetten naar mijn examenbestand, is mij nog niet gelukt. (eigen weet ik niet zoveel van Marco's , hij geeft dan nog verschillende foutmeldingen)

@cow18 Sorry voor de samengevoegde cellen.. de jaarplanning komt vanuit hogeraf en heb ik zo aangeleverd gekregen.
Is het makkelijker om een jaarplanner zonder samengevoegde cellen te maken? want dit zou ik eventueel aan kunnen passen.
Wanneer ik bij het test-bestandje een datum wijzig en de macro opnieuw afspeel geeft hij helaas foutmeldingen.

Via office template kan ik dit voorbeeld tegen met een maandkalender.
https://templates.office.com/nl-nl/huiswerkagenda-tm00000015

Dit werkt niet via marco's is zoiets ook nog een optie of werkt marco's dan beter?

 

[HSV]

Omzetten naar mijn examenbestand, is mij nog niet gelukt. (eigen weet ik niet zoveel van Marco's , hij geeft dan nog verschillende foutmeldingen)

En daar behoeft geen uitleg bij?
Het resultaat is het enige wat telt?

Anders val je mooi door de mand.

 

[GENL]

Na het weekend ga ik mij beter verdiepen in de macro's die jullie mij hebben gestuurd en voor mij hebben gemaakt en ontleden.. Wat hij precies bij welke stap doet. Vindt het intressant en leuk om te weten hoe het werkt!

 

[GENL]

Het is gelukt, ik heb de verschillende Marco's bekeken en uiteindelijk die van VenA toegepast op het originele document.
Heb er nu ook voor kunnen zorgen dat de vakanties (tekst blijft staan) dit door sh.Range aan te passen.
En heb een button aangemaakt zodat ik de macro snel kan gebruiken. Ben er heel blij mee, bedankt allen voor de hulp!

Nog wel twee kleine vragen:
Nu geeft hij aan EXA- (examennaam) (klassen) is het ook mogelijk om EXA- (klassen) (examennaam) te doen.
De volgorde aan te passen. Vindt het nog lastig te lezen wat hij bij welke stap precies doet.

En is het mogelijk om in de marco ook op te nemen dat hij de opmaak > Rijhoogte AutoAanpassen bij alle sheets uitvoert?
Zodat dit stukje automatisch meegaat bij verandering van planning.

 

[VenA]

Een beetje husselen met deze

r.Offset(, x) = ar(j, 3) & " " & ar(j, 5) & " " & ar(j, 6)

Hier wordt het aanelkaar geknoopt, kan niet zo heel moeilijk zijn om daar wat in aan te passen.

@HSV, Jouw suggestie in #5 gaf een kleine verbetering. Verder nog niet gekeken waarom niet alles gevonden wordt.

 

[HSV]

Het gaat mis op het jaartal met die exotische opmaak.

Hij ziet bv. 18-05-2021 aan voor 18 mei 2020.
Zo gaat dat beter.

Aanpassing in code van @cow18.

Sub Planner()
   a = Sheets("Examens").Range("A1").CurrentRegion   'lees al je examens in
   For i = 2 To UBound(a)                        'loop al je examens 1 per 1 af
      If Not Evaluate("ISREF('" & a(i, 2) & "'!A1)") Then
         MsgBox "tabblad " & a(i, 2) & " bestaat niet !!!" & vbLf & "rij : " & i & vbLf & vbLf & Join(Application.Index(a, i, 0), vbLf), vbCritical
      Else
         With Sheets(a(i, 2)).Range("A1:Y47")    'kijk in het goeie tabblad in dat bereik
        dd = Format(a(i, 13), "d\/m[COLOR=#ff0000]\[/COLOR]")  'vertaal je datum in het goeie format
             Set c = .Find(dd, , xlValues, xlWhole) 'zoek die datum
            If Not c Is Nothing Then
[COLOR=#ff0000]             If CLng(c.Value) = CLng(a(i, 13)) Then[/COLOR]
[COLOR=#0000ff]                'MsgBox c.Address 'gevonden[/COLOR]
               If c.Column Mod 5 = 2 Then        'staat in de 2e, 7e, 12e 17e of 22e kolom, anders fout
                  s = a(i, 3) & " - " & a(i, 6) & " - " & a(i, 5)   'tekst voor in die cel
                  For i1 = 1 To 3                'loop de 3 cellen ernaast af
                     Select Case c.Offset(, i1).Value   'kijk naar inhoud van die cellen
                        Case "", s: c.Offset(, i1).Value = s: Exit For   'cel is leeg of inhoud is identiek = wegschrijven en klaar
                     End Select
                     If i3 = 3 Then MsgBox "alle 3 vol !!! " & vbLf & "rij : " & i & vbLf & vbLf & Join(Application.Index(a, i, 0), vbLf), vbCritical    'na de 3e loop nog niet weggeschreven = alles vol voor die dag
                  Next
               End If
    
            Else
               MsgBox "Datum niet gevonden !!!" & vbLf & "rij : " & i & vbLf & vbLf & Join(Application.Index(a, i, 0), vbLf), vbCritical    'datum niet gevonden
            End If
[COLOR=#ff0000]End If[/COLOR]
         End With
      End If
   Next
End Sub

 

[sylvester-ponte]

of zo iets?

 

[GENL]

VenA, ook het veranderd van de code is gelukt! i.v.m. de volgorde.
Heb van de week ook het een en andere aangepast, dat ik hem tot einde van dit schooljaar ook kan gebruiken.
Door Corona is heel de jaarplanning op de schop gegooid, een goed moment om de code te testen!

Nogmaals bedankt voor de hulp!