kleuren en tellen met voorwaardelijke opmaak

[japiejoo]

Hallo allen,

Ik zit met een probleem die ik al ver heb opgelost alleen de voorwaardelijke opmaak krijg ik niet goed.
Zie het voorbeeld.

In kolom A staan de data en in kolom B een tijd.
Nu wil ik de tijd van maandag 21:00 tot dinsdag 07:00 een kleur geven, bijvoorbeeld ROOD
dan het volgende window van Dinsdag 21:00 tot woensdag 07:00 GEEL
dan
Woensdag 21:00 tot donderdag 07:00 weer ROOD
Donderdag 21:00 tot vrijdag 07:00 GEEL
Vrijdag 21:00 tot zaterdag 07:00 ROOD
zaterdag 21:00 tot zondag 07:00 GEEL
zondag op maandag doet niet mee
Daarna de kleuren tellen en het aantal op de eerste regel zetten, zie voorbeeld
Het gaat dus niet om de datums maar om de dagen in de week.

Wie kan me op weg helpen.
Alvast dank

 

[E v R]

zie bestandje, voorwaardelijke opmaak, in kolom A+B
tellen van "streaks" even middels hulpkolom gedaan

 

[japiejoo]

klasse

Geweldig, bedankt
in 1 keer goed.
Ga het proberen te doorgronden.

Is het ook zo te maken dmv een macro?
Dat door de druk op de knop alles wordt verwerkt?
Als ik nu de lijst door nieuwe gegevens vervang staat overal verwijderd

gr japie

 

[sylvester-ponte]

zonder hulpkolommen:

 

[japiejoo]

telt niet op

deze werkt gedeeltelijk
de gekleurde velden moeten ook opgeteld worden.
Mooiste zou zijn dat alles onder een macrotoets zit want ik heb steed nieuwe data om te bewerken.
Als de data op deze manier bewerkt is kan ik er automatisch een grafiek van maken.

gr John

 

[sylvester-ponte]

of met 2 (verstopte) hulpkolommetjes zie grijze cellen

 

[VenA]

Zonder hulpkolommen en met alleen een macro.

Sub VenA()
 x = 1
 Columns(3).ClearContents
 Range("A:B").Interior.Color = xlNone
  With Cells(1).CurrentRegion.Resize(, 3)
    ar = .Value
    For j = UBound(ar) To 1 Step -1
      y1 = Weekday(ar(j, 1) + ar(j, 2) - 7 / 24, 2) Mod 2
      If j > 1 Then y2 = Weekday(ar(j - 1, 1) + ar(j - 1, 2) - 7 / 24, 2) Mod 2
      Cells(j, 1).Resize(, 2).Interior.Color = IIf(y1 = 0, vbYellow, vbRed)
      If y1 <> y2 Or j = 1 Then
        ar(j, 3) = x
        x = 1
       Else
        x = x + 1
      End If
    Next j
    .Value = ar
  End With
End Sub

 

[sylvester-ponte]

japie, kan het voorkomen dat er bvb een hele woensdag uitvalt?
zo ja , krijg je dan bvb di rood, do geel?
of de di rood , wo is er niet ,en dan toch do rood. dus 2 maal rood achter elkaar.

 

[japiejoo]

kleuren

Allen,

De macro werkt perfect, zal zo wat nieuwe lijsten genereren voor de volgende maanden en testen maar het lijkt er op dat die perfect werkt.
Ik kan nu alles integreren en met 1 druk op de knop mijn grafiek maken.

perfect

thx allen.