Выделите ячейку, если больше, чем сегодня - PullRequest
0 голосов
/ 16 ноября 2018

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

Столбец H отформатирован как Дата.

У меня есть следующее:

Sub Test()
    Dim lrow As Long
    lrow = Cells(Rows.Count, 1).End(xlUp).Row
    Columns("H:H").EntireColumn.AutoFit
    If Range("H2:H" & lrow).Value > Date Then Cell.Interior.Color = vbYellow
End Sub

Я получаю ошибку "Несоответствие типов".

Ответы [ 4 ]

0 голосов
/ 17 ноября 2018

В ответ на предложение @ MatthieuGuindon к ответу @ CharlesPL, вот код, который выполняет условное форматирование.Я установил его так, чтобы он выделял даты, которые после дня, когда вы запускаете его, были ярко-желтыми.

Option Explicit

Sub setCondFormat()
Dim lrow As Long

lrow = ActiveSheet.Range("H" & ActiveSheet.Rows.Count).End(xlUp).Row
With Range("H2:H" & lrow)
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
    "=H2>TODAY()"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
    End With
End With

End Sub
0 голосов
/ 16 ноября 2018

Используйте условное форматирование! Как следует из названия, это построить для этого!

Сообщение в блоге Microsoft о дате условного форматирования

enter image description here

0 голосов
/ 16 ноября 2018

Range("H2:H" & lrow).Value будет двумерным массивом (Value из Range всегда является двумерным массивом, если задействовано более одной ячейки);вы получаете несоответствие типов , потому что вы не можете сравнить 2D-массив с Date;если вы не можете использовать условное форматирование , вам нужно сравнить отдельные индексы массива.

Последнее, что вы хотите сделать, - это итерировать каждую отдельную ячейку (в противном случае ваш следующий вопрос будетmsgstr "как заставить этот цикл работать быстрее?"Получите этот массив в Variant и итерируйте этот массив - так как это всего 1 столбец, сделайте его одномерным массивом с Application.Transpose:

Dim values As Variant
values = Application.Transpose(Range("H2:H" & lastRow).Value)

Dim i As Long, current As Long
For i = LBound(values) To UBound(values)
    current = i + 1 'array would be 1-based, so to start at row 2 we need to offset by 1
    If values(i) > Date Then
        ActiveSheet.Cells(current, 8).Interior.Color = vbYellow
    End If
Next

Таким образом, вы попадете на лист только тогда, когда вы иметь к.

0 голосов
/ 16 ноября 2018

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

Dim rng As Range, cell As Range
Set rng = Range("H:H")

For Each cell In rng
   If cell.Value > Date Then cell.Interior.Color = vbYellow
Next cell
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...