Excel VBA：在多种条件下为单元格着色

Question

我目前正在修改一些预先编写的代码，所以我创建了一个测试虚拟文件。我正在经历不当行为，我无法找到罪魁祸首。首先是我的 Excel 数据表示例：

Issue Date  Maturity    Status  ISIN            Price
19/01/2018  06/01/2020  Issued  XS2375645421    97
25/01/2013  01/01/2020  Issued  XS0879579182    88
12/01/2015  07/01/2020  Issued  XS4158674165    92
20/01/2018  05/01/2020  Issued  XS5458614653    98
31/01/2018  03/01/2020  Traded  XS5445656466    87
06/02/2018  02/01/2020  In Sub  XS1515113535    99

此外，您会在下面找到我的代码：

Sub Button1_Click()


Dim wb As Workbook
Dim ws As Worksheet
Dim count As Integer
Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1")
'if wb is other than the active workbook
wb.Activate
ws.Select


'Colorizing The ISIN with the following 3 conditions:

'1.) Issue Date <= today
'2.) Issue Date + 14d > today
'3.) Price <= 98
'So in summary the conditions mean that today has to be in between the Issue Date
'and 14 days after the Issue Date and the price has to be lower than 98

count = 0
Do While CDate(ws.Cells(2 + count, 1).Value) <= CDate(Now()) And _
ws.Cells(2 + count, 5).Value <= 98 And _
CDate(DateAdd("d", 14, ws.Cells(2 + count, 1).Value)) > CDate(Now())

count = count + 1

ws.Range("D" & count + 1).Interior.Color = RGB(250, 50, 50)

Loop



End Sub

代码部分工作，第一个 ISIN 值被着色，但之后如果不满足所有条件，循环会突然停止。如果继续，第 5 行中的 ISIN 也应该是彩色的，因为所有条件都满足。请看下面的截图：

谁能帮我解决这个问题？

提前致谢！

亲切的问候

Answer 1

问题

您的循环停止，因为它只运行到 3 个条件中的 一个 为假。还有你的情况

CDate(DateAdd("d", 14, ws.Cells(2 + count, 1).Value)) > CDate(Now())

对于第二个数据行已经是假的了。这意味着跳过第二行之后的所有内容。

---

VBA 解决方案

因此，您需要一个循环遍历所有数据行，并使用if 语句检查条件是否满足。如果为 true，则为它着色，如果不移动到下一行。

Public Sub Button1_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim count As Long 'we need to use Long instead of Integer
                      'Excel has more rows than Integer can handle
    Set wb = ThisWorkbook 'ThisWorkbook = the wb where this code runs .. is better than
                          'ActiveWorkbook = any workbook that is in focus at the moment
    Set ws = wb.Sheets("Sheet1")
    'if wb is other than the active workbook
    wb.Activate 'this is not needed to run the code
    ws.Select 'this is not needed to run the code

    count = 0
    Do While ws.Cells(2 + count, 1).Value <> vbNullString 'do while first cell contains data
        If CDate(ws.Cells(2 + count, 1).Value) <= CDate(Now()) And _
           ws.Cells(2 + count, 5).Value <= 98 And _
           CDate(DateAdd("d", 14, ws.Cells(2 + count, 1).Value)) > CDate(Now()) Then

            'color it
            ws.Range("D" & count + 1).Interior.Color = RGB(250, 50, 50)
        End If

        count = count + 1 'next row
    Loop
End Sub

注意：看看我制作的改进代码的 cmets。

---

条件格式解决方案

作为 VBA 的替代方案，我建议使用条件格式。

使用此公式添加新的条件格式设置规则

=AND(A2<TODAY(),E2<=98,A2+14>TODAY())

到单元格 D2 并将格式复制到 D 列中的其他单元格。 当您更改数据值时，条件格式会立即更改，您无需为此运行 VBA 代码。