В Excel как заменить цвет ячейки на два условия - PullRequest
0 голосов
/ 01 ноября 2019

В моем листе Excel первое условие состоит в том, чтобы выделить пересеченную ячейку СИНИМ цветом на основе сопоставления текста строки и столбца.

Второе условие: значения ячеек, выделенные синим цветом, должны измениться на красный, еслизначение ячейки (формат даты) меньше сегодняшней даты.

Я могу выполнить первое условие, но не могу выполнить второе условие.

Данные Excel выглядят следующим образом:

Первое условие:

enter image description here

Второе условие: проблема, с которой я столкнулся, чтобы получить красный интерьер

enter image description here

Я пытаюсь с кодом VBA, как показано ниже:

Sub RunCompare()

    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim cols As Range, rws As Range
    Dim lastRow As Integer: lastRow = ws.UsedRange.Rows.Count
    Dim lastColumn As Integer: lastColumn = ws.UsedRange.Columns.Count
  
    For Each cols In ws.Range(ws.Cells(4, 1), ws.Cells(4, lastColumn))
        If cols.Value <> vbNullString Then
            For Each rws In ws.Range("A1:A" & lastRow)
                'first condition statement
                If (rws.Value = cols.Value) Then 
                ws.Cells(rws.Row, cols.Column).Interior.Color = RGB(15, 219, 241)
                End If
                
                'second condition statement
                If (rws.Value = cols.Value) < Date Then           
                ws.Cells(rws.Row, cols.Column).Interior.Color = RGB(255, 0, 0)
                End If
            Next   
        End If
    Next
    
End Sub

Ответы [ 2 ]

2 голосов
/ 01 ноября 2019

Это легко сделать с помощью условного форматирования.

Добавьте два правила на основе этих формул:

  • КРАСНЫЙ: =AND($A3=B$1,B3<>"",B3<TODAY()).

  • СИНИЙ: =AND($A3=B$1,B3<>"")

enter image description here

Если вы действительно хотите сохранить текущий VBA, вы можете изменить

If (rws.Value = cols.Value) < Date Then

на

If (rws.Value = cols.Value) And (ws.Cells(rws.Row, cols.Column).Value < Date) Then    

Или вы можете еще больше упростить, переместив КРАСНОЕ условие в существующую СИНЮЮ проверку состояния (rws.Value = cols.Value должно быть верно как для красного, так и для синего.)

If rws.Value = cols.Value Then
    With ws.Cells(rws.Row, cols.Column) 
        If .Value < Date Then
            .Interior.Color = RGB(255, 0, 0) ' RED
        Else 
            .Interior.Color = RGB(15, 219, 241) ' BLUE
        End If
    End With
End If
0 голосов
/ 01 ноября 2019

Это решение подходит для вас?

Dim ws As Worksheet

Dim col As Integer
Dim row As Integer
Dim lastRow As Integer
Dim lastCol As Integer
Dim OK As Boolean

Set ws = ActiveSheet
lastRow = ws.UsedRange.Rows.Count
lastCol = ws.UsedRange.Columns.Count

For col = 1 To lastCol
    For row = 2 To lastRow
        If ws.Cells(row, 1).Value = ws.Cells(1, col).Value Then
            If ws.Cells(row, col) < Date Then
                ws.Cells(row, col).Interior.Color = RGB(255, 0, 0)
            Else
                ws.Cells(row, col).Interior.Color = RGB(15, 219, 241)
            End If
        End If
    Next
Next
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...