изменить цвет фона для частичной строки в зависимости от 1 ячейки

Question

Так что я на последнем препятствии с моим VBA-кодированием. Я создаю расписание для нескольких разных стран, и мне нужно, чтобы фон для ячеек A7: H300 окрашивался автоматически в зависимости от значения в той же конкретной строке, являющегося кодом страны.

Я знаю, что могу использовать условное форматирование, но цвета не копируются и не вставляются на отдельный лист с использованием этого метода.

Код, который я имею ниже, работает, но он окрашивает D: K вместо ожидаемого A: H - значение в строке D, поэтому я предполагаю, что это проблема, но я не могу обойти ее.

Спасибо за помощь:)

Sub ChangeColour()

Set PC = Range("A:H")
For Each cell In PC
If cell.Value = "BEZEE" Then cell.Columns("A:H").Interior.ColorIndex = 40
If cell.Value = "BEANR" Then cell.Columns("A:H").Interior.ColorIndex = 40
If cell.Value = "DEBRH" Then cell.Columns("A:H").Interior.ColorIndex = 37
If cell.Value = "FRLEH" Then cell.Columns("A:H").Interior.ColorIndex = 38
If cell.Value = "GBBRS" Then cell.Columns("A:H").Interior.ColorIndex = 35
If cell.Value = "GBLPL" Then cell.Columns("A:H").Interior.ColorIndex = 35
If cell.Value = "GBSOU" Then cell.Columns("A:H").Interior.ColorIndex = 35
If cell.Value = "NLRTM" Then cell.Columns("A:H").Interior.ColorIndex = 40
If cell.Value = "FIHNO" Then cell.Columns("A:H").Interior.ColorIndex = 36
If cell.Value = "SEGOT" Then cell.Columns("A:H").Interior.ColorIndex = 36
If cell.Value = "ZADUR" Then cell.Columns("A:H").Interior.ColorIndex = 45
If cell.Value = "ZAELS" Then cell.Columns("A:H").Interior.ColorIndex = 45
If cell.Value = "ZAPLZ" Then cell.Columns("A:H").Interior.ColorIndex = 45

Next

End Sub

Answer 1

Вы обращаетесь к неправильному диапазону. То, как вы пытаетесь это сделать, эффективно действует как Offset по сравнению с Cell. Лучшим способом написания этого было бы следующее:

Public Sub ChangeColour()
    Dim PC As Range, LastRow As Range
    Dim ColorIndexValue As Long
    Dim cell

    ' Set your desired range - Should reference Relevant worksheet as well
    Set PC = Range("A7:H1000")

    ' Find last used row in that range - This will help limit the number of loops on a fixed range and speed up execution
    Set LastRow = PC.Find(what:="*", _
                          after:=Cells(PC.Row, PC.Column), _
                          lookat:=xlWhole, _
                          LookIn:=xlValues, _
                          searchorder:=xlByRows, _
                          searchdirection:=xlPrevious)

    If Not LastRow Is Nothing Then
        ' Resize PC to actual used range instead of working on entire sheet
        Set PC = PC.Cells(1).Resize(LastRow.Row, PC.Columns.Count)

        ' Loop through all cells in range in Column D
        For Each cell In PC.Columns("D").Cells
            ' Set ColorIndexValue variable based on cell value
            Select Case cell.Value2
                Case "GBBRS", "GBLPL", "GBSOU": ColorIndexValue = 35
                Case "FIHNO", "SEGOT": ColorIndexValue = 36
                Case "BEANR", "DEBRH": ColorIndexValue = 37
                Case "FRLEH": ColorIndexValue = 38
                Case "BEZEE", "NLRTM": ColorIndexValue = 40
                Case "ZADUR", "ZAELS", "ZAPLZ": ColorIndexValue = 45
                Case Else: ColorIndexValue = 0
            End Select
            ' Set cell Color. Skip 0 as assume cell is 0 by default
            If ColorIndexValue > 0 Then
                ' Calculates applicable range from cell and PC context
                With Range(cell.Offset(0, PC.Cells(1).Column - cell.Column), cell.Offset(0, PC.Cells(1, PC.Columns.Count).Column - cell.Column))
                    .Interior.ColorIndex = ColorIndexValue
                End With
            End If
        Next cell
    End If
End Sub

Answer 2

Я думаю, вы могли бы попробовать:

Option Explicit

Sub test()

    Dim Lastrow As Long, i As Long

    With ThisWorkbook.Worksheets("Sheet1")

        Lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row

        For i = 1 To Lastrow

            If .Range("D" & i).Value = "BEZEE" Or .Range("D" & i).Value = "BEANR" Or .Range("D" & i).Value = "NLRTM" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 40
            ElseIf .Range("D" & i).Value = "DEBRH" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 37
            ElseIf .Range("D" & i).Value = "FRLEH" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 38
            ElseIf .Range("D" & i).Value = "GBBRS" Or .Range("D" & i).Value = "GBLPL" Or .Range("D" & i).Value = "GBSOU" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 35
            ElseIf .Range("D" & i).Value = "FIHNO" Or .Range("D" & i).Value = "SEGOT" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 36
            ElseIf .Range("D" & i).Value = "ZADUR" Or .Range("D" & i).Value = "ZAELS" Or .Range("D" & i).Value = "ZAPLZ" Then
                .Range("A" & i & ":H" & i).Interior.ColorIndex = 45
            End If

        Next i

    End With