更改部分行的背景颜色，取决于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