包含多个 'past due' 项的 MsgBox

Question

我正在 Excel 2016 年为一个制造项目构建 LOP（开放点列表）。每个行动项目将有一个 'target date' 用于完成。我的意图是每次打开文档时，一个宏运行将扫描文档和每个过期的项目，将 'target date' 与今天的日期进行比较，将触发一个 MsgBox 弹出窗口，其中说明 "There are past due items in the following row(s): X, Y, and Z." 我有运行两个我试图解决的问题：

运行'target date' 列 (J) 的单元格不会产生结果。如果我输入单个单元格，它将显示 MsgBox。例如，如果我只将运行ge 作为 J4，而 J4 已逾期，则 MsgBox 将按预期显示。但是，如果我将运行ge 设置为 "J4:J999"，并且在 J 列中有多个条目已过期并且运行它，它什么都不做，甚至不给我一个错误。
我不知道如何将日期比较代码集成到多输出 MsgBox 代码中。也许一旦运行ge 问题得到解决，它就会有所帮助。

下面是我用来识别 J 列中过去到期的单元格并生成 MsgBox 的代码：

Private Sub Workbook_Open()
Dim cl As Range
Set cl = ThisWorkbook.Sheets("OPEN ITEMS").Range("J4:J999")
If IsDate(cl) Then
    If Now >= cl Then
        MsgBox "There are past due items in the following row(s):" & "" & cl.Address, vbExclamation, "ACTION REQUIRED"
    End If
End If
End Sub

如有任何帮助，我们将不胜感激。

Answer 1

试试这个代码：

编辑：根据 BigBen 的评论，如果没有行满足条件则添加控制。（谢谢@BigBen）

Private Sub Workbook_Open()
    Dim evalRange As Range
    Dim evalCell As Range
    Dim resultRows As String

    Set evalRange = ThisWorkbook.Sheets("OPEN ITEMS").Range("J4:J999")
    For Each evalCell In evalRange
        If IsDate(evalCell) Then
            If Now >= evalCell Then
                resultRows = resultRows & evalCell.Row & ","
            End If
        End If
    Next evalCell

    If resultRows <> vbNullString Then
        ' Remove last comma
        resultRows = Left$(resultRows, Len(resultRows) - 1)

        MsgBox "There are past due items in the following row(s):" & resultRows, vbExclamation, "ACTION REQUIRED"

    End If

End Sub

Answer 2

一种方法是在数组上创建一个循环（可能是首选），但让我向您展示一种无需任何迭代的方法：

Private Sub Workbook_Open()

Dim lr As Long
Dim arr As Variant
Dim rng As Range

With ThisWorkbook.Sheets("OPEN ITEMS")

    'Get last used row and create a range object
    lr = .Cells(.Rows.Count, 10).End(xlUp).Row
    Set rng = .Range("J4:J" & lr)

    'Get data into array
    arr = Filter(.Evaluate("TRANSPOSE(IF(" & rng.Address & ">=NOW(),ROW(" & rng.Address & "),""|""))"), "|", False)

    'Use array in any message you like
    MsgBox "There are past due items in the following row(s): " & Join(arr, ",")

End With

End Sub

虽然这绕过了任何迭代的需要，但是它确实使用了一个数组公式，它在大数据上确实会减慢速度（虽然 1000 行并没有那么多）。

Note: Keep in mind that the max amount of characters in a Msgbox prompt is approximately 1024.

我刚刚在大约 1000 行所有逾期数据上尝试了这段代码，尽管它仍然很快，但其中大约一半不会显示在消息框中！

包含多个 'past due' 项的 MsgBox

MsgBox with multiple 'past due' items

excel

vba

date

msgbox