Excel 根据1个单元格更改部分行的背景色

因此，我的VBA编码已经到了最后一关。我正在为几个不同的国家创建一个时间表，需要单元格A7:H300的背景自动上色，这取决于同一特定行中的一个值，即国家代码

我知道我可以使用条件格式，但颜色不会使用该方法复制并粘贴到单独的表格中

我下面的代码可以工作，但是它给D:K上色，而不是预期的A:H——值在D行，所以我猜这就是问题所在，但我无法找到解决方法

谢谢你的帮助：）

---

你的地址范围不对。您尝试这样做的方式有效地充当了引用的

单元格

的

偏移量

。一种更好的书写方式是：

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

---

你的地址范围不对。您尝试这样做的方式有效地充当了引用的

单元格

的

偏移量

。一种更好的书写方式是：

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

我想你可以试试：

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

我想你可以试试：

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

---

非常感谢你，你不仅解决了我的问题，而且现在速度也加快了！你是个明星！！太好了：）-如果您的问题现在已经解决，请单击正确答案旁边的勾号：）非常感谢您不仅解决了我的问题，而且现在速度也加快了！你是个明星！！太好了：）-如果您的问题现在已解决，请单击正确答案旁边的勾号：）