1

I manage a contract log that list out all of my company's contracts with the effective and expiring date.

I've written VBA code that alerts me whenever any one of the contracts is about to expire; a message box will show up that tells me the "carrier's contract# is about to expire". (Please see the code below).

However, because there are different Amendments for each contract, the same contract number may be listed out multiple times in the spreadsheet. If one contract is about to expire, the code notifies me multiple times.

How can I modify my code so it only alerts me once for the same contract number?

Column A is the carrier name, column B is the contract #, Column C is the Amendment# and Column G is the expiration date for each contract.

Let me know if I didn't make myself clear enough or more information is needed. 

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
4

2 回答 2

1

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

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

Dim AlreadyChecked As String

AlreadyChecked = "@"
If Instr(AlreadyChecked, "@" & ValueToCheck & "@") = 0 Then
  AlreadyChecked = AlreadyChecked & ValueToCheck & "@"
  ... do your stuff ...
End If
于 2013-06-13T17:06:09.467 回答
1

我会使用 aScripting.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代替。

于 2013-06-13T18:23:28.120 回答