Excel VBA代码修改，以便同一项目只提醒我一次

Question

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

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

但是，由于每个合同都有不同的修改，因此同一合同号可能会在电子表格中多次列出。如果一个合约即将到期，代码会多次通知我。

我如何修改我的代码，使其对于相同的合同号只提醒我一次？

A栏是承运商名称，B栏是合同号，C栏是Amendment#，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

上面的代码需要对微软脚本运行时库的引用，或者简单地说是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