Planning Excel

[Henk Benter]

Timshel, ik hoop dat je online bent of nog komt, gisteren heb je mij namelijk perfect geholpen. De aangepaste planning heeft namelijk nog een vervolg nodig. Wellicht voor jou een kleinigheid gezien de code die je mij hebt gedaan.

Vandaag ben ik weer verder gegaan met de bouw van mijn planning. Wanneer ik nu in cel C1 een datum ingeef, dan wordt de planning getoond vanaf die datum. De datum in de velden K3 t/m CN3, gisteren waren dit nog ingetoetste harde datums, is nu niet meer een ingegeven harde datum maar vervangen door een formule (=K4, =L4, enz.) De code die ik gisteren van je kreeg, ik heb deze getracht te doorgronden, maar ik kan er geen touw aan vastknopen (ben absoluut geen VBA kenner), kijkt volgens mij naar een absolute waarde in K3 en geeft op basis van die ingegeven harde datum een kleurtje. Nu staat daar de formule en werkt de code niet. Gevolg de cellen worden kleurloos getoond.

Tevens kleuren de cellen niet op als de datum van aanvang van de werkzaamheden voor de datum in K3 (in dit geval voor 29 februari) ligt. Het is fraai wanneer het aantal overgebleven dagen zichtbaar blijft in de balkenplanning (1e regel 29 februari t/m 9 maart).

Heb jij, of heeft iemand een oplossing hiervoor. Ik heb mijn planning bijgevoegd.

Hoop dat het e.e.a. duidelijk is uitgelegd. Al vast dank.

 

[Timshel]

Datums blijven een lastig verhaal in VBA maar er is mee te werken.
Iets anders: in het voorbeeld op regel 5 valt de startdatum (25 feb) buiten het bereik.
Om voor die eventualiteit te corrigeren zijn wel de nodige programmaregels nodig:

Sub tsh()
    Dim Br, Dt
    Dim i As Long
    Dim ClD As Range, ClP As Range
    Dim sDt, eDt, lDgn As Long
    
    With Sheets("Planning Uitvoering")
        Br = .Cells(5, 1).Resize(Application.Count(.Columns(8)), 9)
        Dt = Application.Transpose(Application.Transpose(.Rows(3).SpecialCells(xlCellTypeFormulas)))
        .Cells(1).CurrentRegion.Offset(4, [columns(A:J)]).Interior.ColorIndex = 0
        For i = 1 To UBound(Br)
            Set ClD = Nothing
            sDt = Application.Match(Val(Format(Br(i, 7), "###0")), Dt, 0) 'startdatum zoeken
            eDt = Application.Match(Val(Format(Br(i, 9), "###0")), Dt, 0) 'einddatum zoeken
            If Not IsError(sDt) Then
                Set ClD = .Range("J3").Offset(, sDt)
                lDgn = Br(i, 9) - Br(i, 7) + 1
            Else
                If Not IsError(eDt) Then
                    Set ClD = .Range("K3")
                    lDgn = eDt
                End If
            End If
            Set ClP = Sheets("Basisgegevens").Columns(4).Find(Br(i, 5), LookAt:=xlWhole)
            If Not ClD Is Nothing And Not ClP Is Nothing And Br(i, 8) > 0 Then
                ClD.Offset(i + 1).Resize(, lDgn).Interior.ColorIndex = ClP.Offset(, 1).Interior.ColorIndex
            End If
        Next
    End With
End Sub

 

[Henk Benter]

Timshel, je hebt precies begrepen wat ik bedoel. De toepassing werkt prima. Heb nogmaals getracht de code te doorgronden, ik begrijp er geen bal van. Zal zijn tijd nodig hebben om dit te doorgronden. In ieder geval hartstikke bedankt. Groet, Henk Benter - Raalte.