☰

Excel - 根据注释中的日期或与文本混合的日期更改单元格颜色

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 worksheet-function vba
Excel - 根据注释中的日期或与文本混合的日期更改单元格颜色

我正在使用 Excel 2010，并尝试设置一条规则，根据单元格内的日期更改单元格的颜色。

例如，单元格可能包含Site meeting - 11.05.14

我希望它能够在还有 2 周、1 周、2 天或过期时自动改变颜色。

理想情况下，我不想有一个单独的单元格只显示日期，所以日期可能在评论中。我意识到我问了很多，但希望有人能有解决方案？

我确实有一个解决方案，但它很粗糙，并不是我真正想要的。使用条件格式和 =NOW 函数，我可以使用两个单元格来实现结果。我希望有一种方法可以告诉 excel 忽略单元格中某个符号之前的所有内容。在本例中是“-”。

通过 Google 搜索，我找到了 VBA，但不幸的是，我不知道如何使用它。所以希望这里有人能帮忙吗？或者至少给我一个正确的方向。

答案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 列中的项目

相关内容