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 语句是否满足条件。如果为真，则为它着色，如果没有移至下一行。

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

注意：查看我对代码进行改进的评论。

条件格式解决方案

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

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

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

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

Excel VBA：在多种条件下给细胞着色

Excel VBA: Coloring cells under multiple conditions

excel

conditional

vba

conditional-formatting

问题

VBA 解决方案

条件格式解决方案