VBA - расширенный макрос, изменяющий цвет ячеек на основе значений из данных - PullRequest
0 голосов
/ 08 января 2019

Я пытаюсь написать код, который меняет цвет ячеек в указанной области на основе ранее определенных значений (дат). Таким образом, если указанная дата минус фактическая дата меньше нуля, то цвет внутренней части ячеек меняется на красный.

Я извлекаю данные из области: от строки 2 до 160 и от столбца 24 до 33. Я проверяю разницу между этими датами и фактической датой, и если она меньше нуля, я хочу, чтобы ячейки в регионе: строка 2 До 160 и от 10 до 19, чтобы изменить цвет на красный.

Я написал простой код, чтобы проверить, работает ли он. Но цвет меняется на красный, пропуская условие (некоторые значения больше нуля и в любом случае они красные).

Sub niowy()

Worksheets("External").Activate

    For i = 2 To 160
        For j = 24 To 33
            For k = 10 To 19
            If Cells(i, j).Value = "" Then
                Cells(i, j).Select
                Cells(i, k).Select
                ElseIf Cells(i, j).Value - Date > 0 And Cells(i, j).Value - Date < 20 Then
                Cells(i, k).Interior.Color = rgbOrange
                ElseIf Cells(i, j).Value - Date < 0 Then
                Cells(i, k).Interior.Color = rgbRed
            End If
            Next k
        Next j
    Next i
End Sub

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

1 Ответ

0 голосов
/ 08 января 2019
Sub niowy()
Dim target As Range
Dim i As Long
Dim j As Long
With Worksheets("Main")

    For i = 2 To 160
        For j = 24 To 33

            If Val(.Cells(i, j)) = 0 Then
            Else
               Set target = .Range("J" & i & ":t" & i)
               Select Case (.Cells(i, j).Value - Date)
                   Case 1 To 20
                        target.Interior.Color = rgbOrange
                   Case Is < 0
                        target.Interior.Color = rgbRed

            End Select
           End If
        Next j
    Next i
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...