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

Заранее большое спасибо.

Sub WorkOutTime()

dim columnToUse as string
columnToUse = "X"  

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

0