Excel VBA 代码修改，因此仅针对同一项目提醒我一次

Question

我管理一个合同日志，其中列出了我公司的所有合同以及生效日期和到期日期。

我编写了 VBA 代码，当任何一份合同即将到期时都会提醒我；将出现一个消息框，告诉我“承运人的合同#即将到期”。 （请参阅下面的代码）。

但是，由于每份合同有不同的修订，相同的合同编号可能会在电子表格中多次列出。如果一份合同即将到期，代码会多次通知我。

如何修改我的代码，以便它只针对相同的合同号提醒我一次？

A 栏是承运人名称，B 栏是合同编号，C 栏是修订编号，G 栏是每份合同的到期日期。

如果我说得不够清楚或需要更多信息，请告诉我。

Private Sub Workbook_Open()
Dim rngC As Range
With Worksheets("NON-TPEB SC LOGS(OPEN)")
    For Each rngC In .Range(.Range("G5"), .Cells(.Rows.Count, "G").End(xlUp))
        If rngC.Value > Now And (rngC.Value - Now) < 7 Then
            MsgBox .Cells(rngC.Row, 1).Value & "'s " & _
                   .Cells(rngC.Row, 2).Value & " is expiring!!"
        End If
    Next rngC
End With
End Sub

Answer 1

我会使用Scripting.Dictionary 来跟踪已检查的合同编号。这就是你可以实现它的方式。

完成逻辑测试后（If rngC.Value > Now And...) 检查字典中是否存在contractNum。这就是这一行的作用：

If Not checkedDict.Exists(contractNum) Then

• 如果计算出True，那么合约还没有被检查，所以我们将它添加到字典中，并显示消息框。
• 如果计算结果为False，则合同确实存在于 字典，所以无能为力，因为用户已经 通知即将到期的合同。

这是完整的代码（未经测试）：

Private Sub Workbook_Open()
'Requires reference to Microsoft SCripting Runtime
' or, simply declare the scripting obects as generic "Object" variables.

Dim checkedDict As Scripting.Dictionary
'Dim checkedDict as Object  '## Use this line (andcomment out the preceding line if you cannot enable the library reference to Scripting Runtime

Dim contractNum As String
Dim carrierName As String
Dim rngC As Range

Set checkedDict = CreateObject("Scripting.Dictionary")

    With Worksheets("NON-TPEB SC LOGS(OPEN)")
        For Each rngC In .Range(.Range("G5"), .Cells(.Rows.Count, "G").End(xlUp))
            carrierName = .Cells(rngC.Row, 1).Value
            contractNum = .Cells(rngC.Row, 2).Value

            If rngC.Value > Now And (rngC.Value - Now) < 7 Then
                If Not checkedDict.Exists(contractNum) Then
                    checkedDict.Add contractNum, carrierName
                    MsgBox carrierName & "'s " & _
                       contractNum & " is expiring!!"
                Else:
                    ' this contract# already exists, so, do nothing
                    ' because the user was already informed.
                End If
            End If

        Next rngC
    End With

    set checkedDict = Nothing
End Sub

以上代码需要引用 Microsoft Scripting Runtime Library，或者，只需 Dim checkedDict as Object。

Answer 2

我总是使用AlreadyChecked 字符串变量来跟踪已处理的内容。

在循环中添加这样的检查：

Dim AlreadyChecked As String

AlreadyChecked = "@"
If Instr(AlreadyChecked, "@" & ValueToCheck & "@") = 0 Then
  AlreadyChecked = AlreadyChecked & ValueToCheck & "@"
  ... do your stuff ...
End If