Excel - изменение цвета ячейки на основе даты в комментарии или в сочетании с текстом

Question

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

Например, ячейка может содержать Site meeting - 11.05.14

Я бы хотел, чтобы он автоматически менял цвет, если он находится через 2 недели, через 1 неделю, через 2 дня и срок его действия истек.

В идеале я не хочу иметь отдельную ячейку с указанием только даты, поэтому, возможно, дата может быть в комментариях. Я понимаю, что спрашиваю много, но надеюсь, у кого-то может быть решение?

У меня есть решение для этого, но оно грубое и не совсем то, что я хочу. Используя условное форматирование и функцию = NOW, я могу добиться результатов, но используя две ячейки. Я надеюсь, что есть способ заставить Excel игнорировать все в ячейке перед определенным символом. В этом случае "-".

Googleing привел меня к VBA, который, к сожалению, я не знаю, как использовать. Надеюсь, кто-то здесь может помочь? Или, по крайней мере, дать мне толчок в правильном направлении.

Answer 1

Это делает то, что вы хотите

Sub WorkOutTime()

    'see http://dmcritchie.mvps.org/excel/colors.htm for colour chart

dim columnToUse as string
columnToUse = "A"    ' update this to the colum you want to use


Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
    Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
    willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub

Итак, на панели инструментов разработчика, нажмите на Вставить и нажмите на кнопку. Перетащите фигуру на экран.

Нажмите ОК

Щелкните правой кнопкой мыши на кнопке и назовите ее WorkOutTime.

Если вы не видите экран VBa, нажмите кнопку Visual Basic на ленте.

Удалите то, что там, и вставьте мой код.

Сохранить как лист с макросами. Запустить его

Обратите внимание, мой код работает только для элементов в столбце A