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个条件中的一个为假之前运行。你的病情

(a,b)

对于第二个数据行已为false。这意味着跳过第二行之后的所有内容。

VBA解决方案

因此，如果满足条件，则需要循环遍历所有数据行并使用CDate(DateAdd("d", 14, ws.Cells(2 + count, 1).Value)) > CDate(Now()) 语句进行检查。如果为true，则如果不移动到下一行则将其着色。

if

注意：看一下我改进代码的评论。

条件格式解决方案

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

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

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

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