读取多个单元格的颜色，并根据颜色将颜色返回到另一个单元格

Posted 2021-03-26

我想连续阅读多个单元格并根据它们是否全部格式化为绿色，将单独的单元格变为绿色。

如果行中的一个单元格为红色或没有颜色，则单元格将保持红色或无颜色，然后遍历我的表格以读取每一行并返回一列单元格中的格式。

当我单击我的更新按钮将新数据带入表格时，单元格列将重置为无颜色然后进行格式化。

[！[在此输入图片说明] [1]] [1]

Sub CS_Click()

Range("D6:D37").Interior.ColorIndex = 0

Dim Range1 As Range

Dim Range2 As Range

    For RR = 1 To 33
     For CC = 1 To 31

        Set Range1 = Cells(RR + 5, CC + 6)
        Set Range2 = Cells(RR + 5, CC + 3)

        If Range1.Interior.ColorIndex = 0 Then
            Range2.Interior.ColorIndex = 0
        ElseIf Range1.Interior.ColorIndex = 38 Then
            Range2.Interior.ColorIndex = 38
        ElseIf Range1.Interior.ColorIndex = 50 Then
            Range2.Interior.ColorIndex = 50
        End If
    Next
 Next
End Sub

答案

我想你可以使用类似下面的东西。这将遍历一个范围并测试该行的ColorIndex范围内的每一行。然后它将使用您选择的ColorIndex更新目标行

Sub CS_Click()
    Dim rng As Range, RowRng As Range
    Dim c As Range
    Dim RowNo As Long
    Dim ClrIndex As Long
    Dim ChangeClr As Boolean

    ' The range of your source data
    Set rng = ActiveSheet.Range("G6:AM37")

    For Each c In rng.Columns(1).Cells
        ClrIndex = -4142
        ChangeClr = False
        RowNo = c.Row - rng.Cells(1).Row + 1
        On Error Resume Next
        Set RowRng = Nothing
        Set RowRng = rng.Rows(RowNo).SpecialCells(xlCellTypeConstants)
        On Error GoTo 0
        If Not RowRng Is Nothing Then
            Select Case RowRng.Interior.ColorIndex
                ' Case 50
                Case 50
                    ClrIndex = 50
                    ChangeClr = True
                ' Blank rows
                Case -4142
                    ChangeClr = False
                ' Others not defined, Null (Mixed color rows) and color 38 rows
                Case Else:
                    ClrIndex = 38
                    ChangeClr = True
            End Select

            If ChangeClr = True Then
                ' Update the 'rng.Coloumns.Count + 1' with the offset of your destination cell
                c.Offset(0, -3).Interior.ColorIndex = ClrIndex
            End If
        End If
    Next c
End Sub

另一答案

我认为您的代码可以简化为：

Sub CS_Click()

    Range("D6:D37").Interior.ColorIndex = 0

    For RR = 1 To 33
        Set Range2 = Cells(RR + 5, 4)
        For CC = 1 To 31
            Set Range1 = Cells(RR + 5, CC + 6)
            c = Range1.Interior.ColorIndex
            If c = 38 Or c = 50 Then
                Range2.Interior.ColorIndex = c
                Exit For ' remove this line as necessary
            End If
        Next
    Next

End Sub

如果你留下Exit For线，那么D栏中的颜色将根据它到达的第一个粉红色或绿色单元格而改变。如果删除它，它将改变每个粉红色或绿色单元格的颜色 - 导致D列代表它检测到的最后一个绿色或粉红色。