Farve celle pba. andre celler der er farvet VBA

Skal det ske "løbende" eller "on demand"?

Det skal ske ved at trykke på en knap, så det må vel være In demand.
Men koden skal gælde for alle rækker, indtil kolonne W er tom for værdier.

"Knappen" kan kalde nedenstående:

Private Sub gennemløbAfOmråde()
Dim antalRæk As Integer
        ActiveSheet.Range("W2").Select
        antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
        For Each cc In Range("X2:AP" & antalRæk)
            If cc.Interior.ColorIndex <> xlColorIndexNone Then
                Range("W" & cc.Row).Interior.ColorIndex = 4
            End If
        Next
End Sub

Alternativt forslag, som giver samme løsning som ovenstående

Sub Farver()

t = 3 'Første udfyldte række i kolonne W. Du kan ændre til eget tal.

Do Until ThisWorkbook.Sheets("Ark1").Cells(t, 23) = "" 'Indtil kolonne W er tom.
    For col = 24 To 42 'Fra kolonne X til AP
        'MsgBox ThisWorkbook.Sheets("Ark1").Cells(t, col).Interior.Color
        If ThisWorkbook.Sheets("Ark1").Cells(t, col).Interior.ColorIndex <> "-4142" Then '"-4142" er værdien, hvis baggrundsfarve ikke er sat
            ThisWorkbook.Sheets("Ark1").Cells(t, 23).Interior.ColorIndex = 6 'Nr. 6 er gul. Du kan vælge mellem 1-56. Alternativt kan du 'Interior.ColorIndex' til 'Interior.Color', for flere valgmuligheder.
        End If
    Next
    t = t + 1
Loop
       
       
End Sub

Private Sub CommandButton1_Click()
    Dim antalRæk As Long, KolSlut As Integer, KolStart As Integer, R As Integer, I As Long

    antalRæk = Range("W2").SpecialCells(xlLastCell).Row
    KolSlut = 42
    KolStart = 24
    For I = 2 To antalRæk
        Range("W" & I).Interior.ColorIndex = xlColorIndexNone
        For R = KolStart To KolSlut

            If Cells(I, R).Interior.ColorIndex <> xlColorIndexNone Then
                Range("W" & I).Interior.ColorIndex = 4
                Exit For
            End If
        Next
    Next
End Sub

kode i arkets modul

@Jessen
Det ser rigtig fint ud :-) Jeg har dog et mindre problem.

Farverne i kolonne W til AP fremkommer via betinget formatering. Det ser ud til, at koden ikke kan fange disse farver?

Hej,

Hvis det er formatting, så skal du erstatte "Interior" med "Interior.DisplayFormat" et enkelt sted.

Prøv denne

Sub test()

Range("C1") = Range("A1").Interior.Color
Range("C2") = Range("A2").Interior.Color


Range("D1") = Range("A1").DisplayFormat.Interior.Color
Range("D2") = Range("A2").DisplayFormat.Interior.Color
End Sub

t = 3 'Første udfyldte række i kolonne W. Du kan ændre til eget tal.

Do Until ThisWorkbook.Sheets("Ark1").Cells(t, 23) = "" 'Indtil kolonne W er tom.
    For col = 24 To 42 'Fra kolonne X til AP
        'MsgBox ThisWorkbook.Sheets("Ark1").Cells(t, col).Interior.Color
        If ThisWorkbook.Sheets("Ark1").Cells(t, col).Interior.DisplayFormat.ColorIndex <> "-4142" Then '"-4142" er værdien, hvis baggrundsfarve ikke er sat
            ThisWorkbook.Sheets("Ark1").Cells(t, 23).Interior.ColorIndex = 6 'Nr. 6 er gul. Du kan vælge mellem 1-56. Alternativt kan du 'Interior.ColorIndex' til 'Interior.Color', for flere valgmuligheder.
        End If
    Next
    t = t + 1
Loop
       
       
End Sub

@Jessen

Jeg har indsat følgende kode under arket:

Sub Farver()


t = 5 'Første udfyldte række i kolonne W. Du kan ændre til eget tal.

Do Until ThisWorkbook.Sheets("B&D uge 25").Cells(t, 23) = "" 'Indtil kolonne W er tom.
    For col = 24 To 42 'Fra kolonne X til AP
        'MsgBox ThisWorkbook.Sheets("Ark1").Cells(t, col).Interior.Color
        If ThisWorkbook.Sheets("B&D uge 25").Cells(t, col).Interior.DisplayFormat.ColorIndex <> "-4142" Then '"-4142" er værdien, hvis baggrundsfarve ikke er sat
            ThisWorkbook.Sheets("B&D uge 25").Cells(t, 23).Interior.ColorIndex = 6 'Nr. 6 er gul. Du kan vælge mellem 1-56. Alternativt kan du 'Interior.ColorIndex' til 'Interior.Color', for flere valgmuligheder.
        End If
    Next
    t = t + 1
Loop
               
End Sub

Når jeg "køre" makroen, så får jeg følgende meddelelse:
Object dosen't support the property or method

Hvad gør jeg forkert?

Hej,

Beklager - jeg havde ikke styr på syntaksen. Prøv igen

Sub Farver()



t = 5 'Første udfyldte række i kolonne W. Du kan ændre til eget tal.

Do Until ThisWorkbook.Sheets("B&D uge 25").Cells(t, 23) = "" 'Indtil kolonne W er tom.
    For col = 24 To 42 'Fra kolonne X til AP
        'MsgBox ThisWorkbook.Sheets("B&D uge 25").Cells(t, col).DisplayFormat.Interior.ColorIndex
        If ThisWorkbook.Sheets("B&D uge 25").Range(Cells(t, col), Cells(t, col)).DisplayFormat.Interior.ColorIndex <> "-4142" Then '"-4142" er værdien, hvis baggrundsfarve ikke er sat
            ThisWorkbook.Sheets("B&D uge 25").Cells(t, 23).Interior.ColorIndex = 6 'Nr. 6 er gul. Du kan vælge mellem 1-56. Alternativt kan du 'Interior.ColorIndex' til 'Interior.Color', for flere valgmuligheder.
        End If
    Next
    t = t + 1
Loop
               
End Sub

jeg har rettet, kravet er at den betingede formattering er baseret på værdien i den celler den virker på, hvis den fremkommer på en betingelse i en anden celle, virker den ikke.

Private Sub CommandButton1_Click()
    Dim antalRæk As Long, KolSlut As Integer, KolStart As Integer, R As Integer
    Dim OK As Boolean, I As Long, F As Integer, FK As Integer

    antalRæk = Range("W2").SpecialCells(xlLastCell).Row
    KolSlut = 42
    KolStart = 24
    For I = 2 To antalRæk
        OK = False
        Range("W" & I).Interior.ColorIndex = xlColorIndexNone
        For R = KolStart To KolSlut
            F = Cells(I, R).FormatConditions.Count    ' antal formater
            For FK = 1 To F
                If Evaluate(Cells(I, R).FormatConditions(FK).Formula1) = Cells(I, R).Value Then
                    Range("W" & I).Interior.ColorIndex = 4
                    OK = True
                    Exit For
                End If
            Next FK
            If OK Then Exit For
        Next
    Next
End Sub

Hej igen, jeg har kikket lidt på nettet, og her er resultatet.

i arkets modul:

Private Sub CommandButton1_Click()
    Dim antalRæk As Long, KolSlut As Integer, KolStart As Integer, R As Integer
    Dim Farve As Long
    antalRæk = Range("W2").SpecialCells(xlLastCell).Row
    KolSlut = 42
    KolStart = 24
    For i = 2 To antalRæk
        Range("W" & i).Interior.ColorIndex = xlColorIndexNone
        For R = KolStart To KolSlut
            Farve = ConditionalColor(Range(Cells(i, R).Address), "Interior")
            Debug.Print Farve
            If Farve <> -4142 Then
                Range("W" & i).Interior.ColorIndex = 4
                Exit For
            End If
        Next
    Next
End Sub


i et kodemodul:


Function ConditionalColor(rg As Range, FormatType As String) As Long

'Returns the color index (either font or interior) of the first cell in range rg. If no _
  conditional format conditions apply, Then returns the regular color of the cell. _
  FormatType Is either "Font" Or "Interior"
    Dim cel As Range
    Dim tmp As Variant
    Dim boo As Boolean
    Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
    Dim i As Long

    'Application.Volatile    'This statement required if Conditional Formatting for rg is determined by the _
    value of other cells

    Set cel = rg.Cells(1, 1)
    Select Case Left(LCase(FormatType), 1)
    Case "f"    'Font color
        ConditionalColor = cel.Font.ColorIndex
    Case Else    'Interior or highlight color
        ConditionalColor = cel.Interior.ColorIndex
    End Select

    If cel.FormatConditions.Count > 0 Then
        'On Error Resume Next
        With cel.FormatConditions
            For i = 1 To .Count    'Loop through the three possible format conditions for each cell
                frmla = .Item(i).Formula1
                If Left(frmla, 1) = "=" Then    'If "Formula Is", then evaluate if it is True
                    'Conditional Formatting is interpreted relative to the active cell. _
                    This cause the wrong results If the formula isn 't restated relative to the cell containing the _
                    Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _
                    If the Function were Not called using a worksheet formula, you could just activate the cell instead.
                    frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
                    frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
                    boo = Application.Evaluate(frmlaA1)
                Else    'If "Value Is", then identify the type of comparison operator and build comparison formula
                    Select Case .Item(i).Operator
                    Case xlEqual    ' = x
                        frmla = cel & "=" & .Item(i).Formula1
                    Case xlNotEqual    ' <> x
                        frmla = cel & "<>" & .Item(i).Formula1
                    Case xlBetween    'x <= cel <= y
                        frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
                    Case xlNotBetween    'x > cel or cel > y
                        frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
                    Case xlLess    ' < x
                        frmla = cel & "<" & .Item(i).Formula1
                    Case xlLessEqual    ' <= x
                        frmla = cel & "<=" & .Item(i).Formula1
                    Case xlGreater    ' > x
                        frmla = cel & ">" & .Item(i).Formula1
                    Case xlGreaterEqual    ' >= x
                        frmla = cel & ">=" & .Item(i).Formula1
                    End Select
                    boo = Application.Evaluate(frmla)    'Evaluate the "Value Is" comparison formula
                End If

                If boo Then    'If this Format Condition is satisfied
                    On Error Resume Next
                    Select Case Left(LCase(FormatType), 1)
                    Case "f"    'Font color
                        tmp = .Item(i).Font.ColorIndex
                    Case Else    'Interior or highlight color
                        tmp = .Item(i).Interior.ColorIndex
                    End Select
                    If Err = 0 Then ConditionalColor = tmp
                    Err.Clear
                    On Error GoTo 0
                    Exit For    'Since Format Condition is satisfied, exit the inner loop
                End If
            Next i
        End With
    End If
End Function

du kan slette det med Debug.Print