Voorwaardelijke opmaak op basis van gegevens uit cellen

[globe]

Beste Helpmij-ers,

Bijgaand een summier voorbeeld van een project waar ik mee bezig ben.

In tabblad Data staan data en namen van medewerkers, deze wisselen vaak.
In tabblad Kalender staan de medewerkers bovenaan en de data dat ze aanwezig zijn kleurt volgens de legenda die ik in de bovenste rij heb gemaakt.

Nu kan ik met voorwaardelijke opmaak met behulp van een ALS icm X.ZOEKEN de cellen laten kleuren.
Dit is prima te doen in het geval van 5 medewerkers.

Het probleem hiervan is dat ik bij nieuwe medewerkers regels aan de voorwaardelijke opmaak moet gaan toevoegen. Dit is niet alleen omslachtig maar vergt ook kennis van Excel, wat de gebruikers van deze sheet maar matig hebben.
Bovendien wordt de sheet erg traag met zoveel verwijzingen en voorwaardelijke opmaak regels.

Is er een makkelijke manier om van de legenda in het blad kalender een cel te kleuren wanneer deze in het blad DATA staat?

dank,

Guido

 

[JEC.]

Nieuwe medewerkers krijgen ook allemaal een nieuwe kleur. Dus het blijft handwerk.
Kortom, de weg die je inslaat met de kleurtjes is niet de juiste.

Wat als twee mensen aanwezig zijn op dezelfde dag?

 

[globe]

Beste JEC,

Bedankt voor je reactie.

2 medewerkers op een dag gaat niet voorkomen in mijn project. Het betreft altijd maar 1 naam.
Ik besef me dat er handwerk aan te pas gaat komen, dat is echter geen probleem.

De kalender die er uit moet komen moet met kleuraanduidingen duidelijk maken wie er is. Ook kun je zo visueel zijn hoe vaak iemand ingedeeld staat en of de verhoudingen eerlijk zijn.

Als ik zelf iets zou moeten maken zou het simpel zijn maar dat is helaas niet het geval.

wil je svp nog even meedenken?

dank,

Guido

 

[popipipo]

Om het probleem van de traagheid en beetje op te lossen kun je het beste het bereik van de zoekfunctie verkleinen

=XLOOKUP(B6;data!$A$1:$A$100;data!$B$1:$B$100;0;0)=$A$1
=XLOOKUP(B6;data!$A$1:$A$100;data!$B$1:$B$100;0;0)=$B$1

Gebruik deze voorwaardelijke opmaak formules en voor elk persoon zul je een nieuwe moeten aanmaken.
dus:

=XLOOKUP(B6;data!$A$1:$A$100;data!$B$1:$B$100;0;0)=$C$1
=XLOOKUP(B6;data!$A$1:$A$100;data!$B$1:$B$100;0;0)=$D$1

enz

 

[JEC.]

Ik zou dan voor zoiets gaan

 

[AHulpje]

Of met formules (niet strikt noodzakelijk, maar misschien handig voor het overzicht) en een beetje VBA:

 

[globe]

Allen bedankt!

Ik denk dat de oplossing van Ahulpje me wel uit de brand gaat helpen. Al zou het beter zijn de namen en kleuren op de eerste rij te houden.

Morgen eens checken of ik vba kan draaien op de computer waar het moet komen te staan!

dank tot zover!

 

[AHulpje]

Sterk vereenvoudigd, gebruikt tabellen, foutmeldingen toegevoegd.

 

[globe]

Helemaal top deze Ahulpje,

1 kleinigheidje, in de kalender wil ik alleen de dag laten zien met celeigenschappen "d".

het script geeft dan aan dat de datum niet op de kalender staat. De cel geeft echter wel de datum voluit aan 1-1-2023.

Hoe zou ik dat op kunnen lossen?

 

[AHulpje]

Maak er dit van:

Set c = Sheets("Kalender").Range("A1").CurrentRegion.Find([COLOR=#ff0000]Day([/COLOR]datum[COLOR=#ff0000])[/COLOR], , xlValues)

 

[globe]

nope, dat is 'm ook niet.

Dan kleurt het script alle dagen correct maar kijkt niet naar de maand helaas.

 

[AHulpje]

Oeps, niet goed naar resultaat gekeken, zag allemaal mooie kleurtjes!
Maar dit werkt beter, bij het uitvoeren van de macro worden de celeigenschappen van de kalender tijdelijk gewijzigd:

Sub KleurKalender()
    Dim oRow As ListRow

    Range("B2:H13").NumberFormat = "m/d/yyyy"
    For Each oRow In Sheets("Data").ListObjects("Tabel1").ListRows
        datum = oRow.Range(1)
        medewerker = oRow.Range(2)
        Kleur = ZoekKleur(medewerker)
        Dim c As Range
        Set c = Sheets("Kalender").Range("A1").CurrentRegion.Find(datum, , xlValues)
        If Not c Is Nothing Then
            c.Interior.Color = Kleur
        Else
            MsgBox "Datum " & datum & " niet gevonden in kalender.", vbExclamation, "Waarschuwing"
        End If
    Next oRow
    Range("B2:H13").NumberFormat = "d"
End Sub

 

[globe]

wow!

Dat lijkt helemaal goed te gaan. Ik ga er mee aan de gang op het uiteindelijke project en laat je weten of het gelukt is.

 

[AHulpje]

En dan is het misschien handig om Range("B2:H13") een naam te geven, bijvoorbeeld "Kalender", dan wordt het

Range("Kalender").NumberFormat = "d"

 

[globe]

Ik ben ondertussen weer wat verder met mijn uiteindelijke project.

Nu loop ik tegen het probleem aan dat vanaf 10-9-2024 de datum niet herkend wordt.
Kan dat te maken hebben dat de dag 2 cijfers wordt?

 

[AHulpje]

Maak de kolommen waarin de datum staat iets breder.
Dat gaat het makkelijkst door de macro via F8 uit te voeren t/m

    Range("B5:o108").NumberFormat = "m/d/yyyy"

Dan de macro afbreken (blauwe vierkantje onder Opmaak)
In plaats van bovenstaande kun je ook de celeigenschappen van de kalender op dd-mm-jjjj zetten.

Vervolgens:
Selecteer hele werkblad Ctrl-A
Dubbelklik op de scheiding tussen kolomletter A en B (Autofit)
De datum verandert dan van ###### in een leesbare datum
Daarna doet hij het weer.

Je zou ook in de code direct na beide keren wijzigen van de opmaak kunnen opnemen:

    Cells.EntireColumn.AutoFit

 

[AHulpje]

Ach, zelf maar even gedaan, en tevens alle X.Zoeken verwijderd, voorstelling en genre worden nu door de macro gevuld.
Worksheet_Change event uitgeschakeld, je snapt wel waarom.

 

[globe]

haha, hoe simpel kan het soms zijn. Ik had nooit rekening met de kolombreedte gehouden.
Raar dat VBA daar over struikelt.

Idd was ik ook al van plan om het zoekgedeelte anders in te richten, dit is een mooie oplossing die je gemaakt hebt.

Ik ga weer aan de klus. dank!