Прочитайте цвет нескольких ячеек и, в зависимости от цвета, верните цвет в другую ячейку. - PullRequest
0 голосов
/ 12 апреля 2019

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

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

И когда я нажимаю кнопку обновления, которая приносит новые данные в таблицу, столбецячейки будут сброшены в цвет, затем будут отформатированы.

[! [введите описание изображения здесь] [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 голосов
/ 12 апреля 2019

Я думаю, ваш код может быть упрощен до:

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 будет представлять последний зеленый или розовый цвет, который он обнаружил.

0 голосов
/ 12 апреля 2019

Я думаю, вы могли бы использовать что-то вроде следующего. Это перебирает диапазон и проверяет каждую строку в диапазоне на 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...