Macro til auto farvelægning

Prøv betinget formatering under formater. Her kan du vælge formlen er og i formelfeltet =AH5="Lørdag" f.eks.

Men hvis det skal være makro, så kan det også fikses :-)

Sådan har jeg gjort det nu, men jeg vil gerne give det nye år en ny farve, så de adskiller klart fra hinanden. Og det er noget besværligt at ændre via betinget formatering.
Iøvrigt indeholder AH5 ingen data, men kun den ønskede baggrundsfarve.

Indsæt denne kode i et arkmodul


Sub worksheet_selectionchange(ByVal target As Range)

If Intersect(target, Range("B1")) Is Nothing Or _
Intersect(target, Range("AH5:AH6")) Is Nothing Then
   
    farve1 = Range("AH5").Interior.ColorIndex
    farve2 = Range("AH6").Interior.ColorIndex
   
    If Range("B1").Value = "Lørdag" Then
        Range("B5:E35").Interior.ColorIndex = farve1
    End If
   
    If Range("B1").Value = "Søndag" Then
        Range("B5:E25").Interior.ColorIndex = farve2
    End If
   
End If
End Sub

En lille rettelse



Sub worksheet_selectionchange(ByVal target As Range)

If Intersect(target, Range("B1")) Is Nothing Or _
Intersect(target, Range("AH5:AH6")) Is Nothing Then
   
    farve1 = Range("AH5").Interior.ColorIndex
    farve2 = Range("AH6").Interior.ColorIndex
   
    If Range("B1").Value = "Lørdag" Then
        Range("B5:E35").Interior.ColorIndex = farve1
    End If
   
    If Range("B1").Value = "Søndag" Then
        Range("B5:E35").Interior.ColorIndex = farve2
    End If
   
End If
End Sub

Som almindelig makro, med fjernelse af eksisterende farve

Public Sub SkiftFarve()
    Dim I As Integer, Farve1 As Integer, Farve2 As Integer
    Farve1 = Range("AH5").Interior.ColorIndex
    Farve2 = Range("AH6").Interior.ColorIndex
    For I = 5 To 35
        Select Case UCase(Cells(I, "B"))
        Case "LØRDAG"
            Range("B" & I & ":E" & I).Interior.ColorIndex = Farve1
        Case "SØNDAG"
            Range("B" & I & ":E" & I).Interior.ColorIndex = Farve2
        Case Else
            Range("B" & I & ":E" & I).Interior.ColorIndex = xlNone
        End Select
    Next
End Sub

Tak, - jeg kigger på det i aften.

kabbak - din løsning dækker præcis min kalender funktion.

Som du nok kan regne ud vil din programstump farvelægge januar. Jeg skal jo så gøre det samme for de resterende måneder. Er der en snildere måde, end at kopiere dit program 11 gange efter hinanden og så rette kolonne bogstaverne? Februar går fra G til J.

Læg et svar for point

Public Sub SkiftFarve()
    Dim I As Integer, Farve1 As Integer, Farve2 As Integer, C As Integer
    Farve1 = Range("AH5").Interior.ColorIndex
    Farve2 = Range("AH6").Interior.ColorIndex
    For C = 2 To 30 Step 5    ' går ud fra at der er 6 måneder, hvor hver måner er 2 celler med 1 tom imellem
        ' hvis du har 12 måneder ved siden af hinanden skal der stå 60 i stedet for 30
        For I = 5 To 35
            Select Case UCase(Cells(I, "B"))
            Case "LØRDAG"
                Range(Cells(I, C), Cells(I, C + 3)).Interior.ColorIndex = Farve1
            Case "SØNDAG"
                Range(Cells(I, C), Cells(I, C + 3)).Interior.ColorIndex = Farve2
            Case Else
                Range(Cells(I, C), Cells(I, C + 3)).Interior.ColorIndex = xlNone
            End Select
        Next I
    Next C
End Sub

For C = 2 To 30 Step 5    ' går ud fra at der er 6 måneder, hvor hver måner er 4 celler med 1 tom imellem
        ' hvis du har 12 måneder ved siden af hinanden skal der stå 60 i stedet for 30
        For I = 5 To 35

Jeg har ikke lige nået at prøve det nye tiltag endnu, men det ser rigtigt ud.

Tak for hjælpen.