kleuren vaststellen op basis van datums

[Demysas]

Beste Forum mensen,

Ik heb een navolgende vraag.

Van iemand heb ik een excelbestand gekregen waarbij, door een genereer knop, een kalender wordt gemaakt in een ander werkblad. Keurig netjes op basis van het jaar de maanden met daarbij de dagen. Nu heb ik in het invoerscherm 2 kolommen erbij gemaakt. De ene kolom is de "startdatum" en de andere kolom is de "einddatum". Nu wil ik eigenlijk dat op en tussen die 2 datums alle cellen in de kalender automatisch een kleur toegewezen krijgen....ook liefst middels die genereer knop... kan dat? En uiteraard.. hoe?

RJ

 

[Wigi]

Hoi

Zoiets:

Sub FindDate()
Dim strdate As String
Dim rCell As Range
Dim lReply As Long

    strdate = Application.InputBox(Prompt:="Enter a Date to Locate on This Worksheet", _
                Title:="DATE FIND", Default:=Format(Date, "Short Date"), Type:=1)

    'Cancelled
    If strdate = "False" Then Exit Sub

    strdate = Format(strdate, "Short Date")

    On Error Resume Next
        Set rCell = Cells.Find(What:=CDate(strdate), After:=Range("A1"), LookIn:=xlFormulas _
            , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    On Error GoTo 0

    If rCell Is Nothing Then
        lReply = MsgBox("Date cannot be found. Try Again", vbYesNo)
        If lReply = vbYes Then Run "FindDate":
    End If
End Sub

Bron en extra uitleg: http://www.ozgrid.com/VBA/find-dates.htm

Wigi

 

[Demysas]

Ik heb even het bestand erbij gevoegd.... Misschien maakt dat toch meer duidelijk.
Het moet een soort machineplanning worden.

succes.. en bedankt nog voor de snelle reactie.

m.vr.gr.,
RJ

 

[Wigi]

Ik heb VBA-code voor jou geschreven:

Sub KleurDatums()

    Dim r As Range
    Dim c As Range
    Dim rij As Integer
    Dim kolom As Integer
    Dim rDag As Range
    
    Sheets("CNC-planning").Select

    For Each c In Sheets("CNC invoer").Range("F4:F5")
    
        rij = (Month(c) - 1) * 7 + 4 - (c.Offset(, -4).Value = "Eduniek")
        kolom = Day(c) + 1
        Set rDag = Cells(rij, kolom)
    
        Do
            
            rDag.Interior.ColorIndex = 3 '3 staat voor rood
            
            Set rDag = rDag.Offset(, 1)
            
            If Len(rDag.Value) = 0 Then Set rDag = Range("B" & rDag.Row + 7)
            
            If Len(rDag.Value) = 0 Then Exit Sub
            
        Loop While DatumUitCel(rDag) <= c.Offset(, 1).Value
        
    Next

End Sub

Function DatumUitCel(r As Range) As Date
    
    DatumUitCel = DateSerial(2007, Int(r.Row / 7) + 1, r.Value)
    
End Function

Wigi