Meerdere cellen kopieren

[petervandijk]

Ik houd mij veel bezig met planningsroosters. Hierbij worden er verschillende soorten diensten in een dagrooster weergegeven. Een dagdienst (bijv. Dg) loopt van 08:00 tot 16:30 uur. Naast de naam van een personeelslid heb ik een cel met de dienst (Dg) en daarna een aantal cellen lopend van 07:00 tot 07:00. Visueel maak ik die vakjes groen waarop gewerkt wordt. Onderaan de rooster heb ik de verschillende diensten onderelkaar neergezet. Als ik een rooster maak dan zet ik handmatig de dienst in de behorende cel en kopieer en plak de uren vanuit onder. Dit wil ik echter automatisch laten gebeuren. Ik moet van een lijst kunnen kiezen welk dienst er is en als die geselecteerd is de juiste aantal vakken gekleurd daarnaast. Hoe doe ik dit???

 

[richard1970]

Beste Peter,

Er kan van alles met formules, voorwaardelijke opmaak en ook VBA, maar een voorbeeldbestandje met fictieve werknemers/rooster verduidelijkt je vraag enorm en maakt het bedenken van een werkbare oplossing eenvoudiger.

Wel even zippen of rarren.

Richard

 

[petervandijk]

Voorbeeld rooster

Heb een voorbeeldje erbij gedaan. Als ik in de kolom 'dienst' een roostercode (bijv. Ag) intik wil ik dat ernaast de bijbehorende oranje vakken geplaatst wordt. Als ik dit voor allee werknemers doe kan ik dit uitprinten en heb ik gelijk een dagrooster.

Peter

 

[Wigi]

Peter,

wil je met formules en Voorwaardelijke opmaak werken, of met een kleine macro?

Beide zijn mogelijk volgens mij.

Wigi

 

[Wigi]

Peter,
wil je met formules en Voorwaardelijke opmaak werken, of met een kleine macro?
Beide zijn mogelijk volgens mij.
Wigi

Hier is de oplossing via VBA code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim foundcell As Range
If Target.Count = 1 Then
    If Not Intersect(Target, Range("E4:E8")) Is Nothing Then
        Set foundcell = Range("E15:E23").Find(Target, lookat:=xlWhole, LookIn:=xlValues, _
            MatchCase:=True)
        If Not foundcell Is Nothing Then
            Range("F" & foundcell.Row).Resize(1, 24).Copy Target.Offset(0, 1)
        Else
            Range("F17").Resize(1, 24).Copy Target.Offset(0, 1)   '**
            MsgBox "De code werd niet gevonden."
        End If
    End If
End If
End Sub

Dit is de code voor het werkblad waarin je wilt dat dit moet gebeuren. Het is een Event.

Laat wel rij 17 leeg (of een andere rij maar duid dat dan aan in de regel code gemarkeerd met **. De 17 moet je daar dan veranderen.)

Wigi

 

[petervandijk]

Kijken of ik het begrijp

Hoi,

Ik geloof dat ik het begrijp. Ik ga het proberen. Had al een macro geprobeerd en dat lukt voor een keer goed maar bij de volgende werknemer springt het gewoon weer naar de vorige werknemer. Zit natuurlijk in de kopieer functie.

Peter

 

[petervandijk]

Het werkt perfect

Precies wat ik bedoelde. Ik heb naar de code zitten kijken en vroeg mij af waarom rij 17 (of een andere rij) leeg moet zijn.

Peter

 

[Wigi]

Precies wat ik bedoelde. Ik heb naar de code zitten kijken en vroeg mij af waarom rij 17 (of een andere rij) leeg moet zijn.

Peter

Stel je typt een code en de opmaak wordt toegepast.

Je wilt echter een andere code hebben en geeft die in. Maar als de code niet gevonden wordt (ze bestaat niet of je typt zonder hoofdletter), dan heb je nog steeds de vorige opmaak. (ook al komt er een MsgBox.) Daarom moeten de cellen dus leeggemaakt worden. Ik kopieer dus lege cellen naar de juiste rij.

Wat je ook zou kunnen doen is voor die rij de oranje kleur afzetten, maar dan je nog steeds met de diagonale streep als rand. En dan zit je weer met alle andere randen in de rijen...

Mijn methode leek me veruit het simpelste, niet?

Wigi

 

[petervandijk]

De oplossing.....

Ja, dit lijkt mij inderdaad de makkelijkste oplossing. Bedankt.:love:

 

[Wigi]

Ja, dit lijkt mij inderdaad de makkelijkste oplossing. Bedankt.:love:

OK, zet de vraag op opgelost en dan is er weer iemand meer content...