读取多个单元格的颜色,然后根据颜色将颜色返回给另一个单元格

时间:2019-04-12 08:03:36

标签: excel vba colors

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

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

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

[![在此处输入图片描述] [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

2 个答案:

答案 0 :(得分:0)

我认为您可以使用类似以下的内容。这将遍历一个范围并测试该行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

答案 1 :(得分:0)

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

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列中的颜色将根据其到达的 first 粉色或绿色单元格而变化。如果将其删除,它将更改每个粉红色或绿色单元格上的颜色-导致D列代表检测到的最后绿色或粉红色。