Betinget formatering med kriterium og data fra andet ark
I Ark1 tastes der datoer i A-kolonnen fra A6 og nedefter. De øverste fem rækker er reserveret til andre formål (her vist med XXXXX). I i række 5, fra B5, står der forskellige opgaver, som skal løses hver dag.
Fra række seks og nedefter indtastes initialerne på den medarbejder, der skal udføre opgaven. Hver medarbejder har en farve, som er specificeret i Ark2. Tanken er nu, at når der i Ark1 indtastes medarbejderens initialer, skal den korrekte farve hentes fra Ark2, og den celle, hvor initialerne står, skal farves med medarbejderens farve. Dette kan gøres med nedenstående kode, som placeres i Ark1's kodemodul. Som det fremgår er der tale om en hændelsesprocedure med hændelsen Worksheet_Change som udgangspunkt. Den udløses altså hver gang, der ændres i Ark1.
Private
Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 5 Then
Select Case Target.Value
Case Is = "jkr"
For Each c In Sheets(2).Range("a1:a4")
If c.Value = "jkr" Then
Target.Interior.Color = c.Offset(0, 1).Interior.Color
End If
Next
Case Is = "jkl"
For Each c In Sheets(2).Range("a1:a4")
If c.Value = "jkl" Then
Target.Interior.Color = c.Offset(0, 1).Interior.Color
End If
Next
Case Is = "skl"
For Each c In Sheets(2).Range("a1:a4")
If c.Value = "skl" Then
Target.Interior.Color = c.Offset(0, 1).Interior.Color
End If
Next
Case Is = "tki"
For Each c In Sheets(2).Range("a1:a4")
If c.Value = "tki" Then
Target.Interior.Color = c.Offset(0, 1).Interior.Color
End If
Next
End Select
End If
End Sub
Eksemplet har kun fire medarbejdere og fire opgaver. Opgaveantallet kan ændres ved simpelthen at tilføje flere overskrifter i række 5, da koden virker for hele arket under række fem. Skal der tilføjes flere medarbejdere, skal der for hver medarbejder tilføjes en ny CaseIs gruppe, og 'For Each c In Sheets(2).Range("a1:a4")' ændres til den relevante , sidste celle med medarbejderinitialer.