Excel VBA代码修改，所以只有相同的项目提醒我一次
我pipe理一份合同logging，列出我公司所有与生效date有关的合同。
我写了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 我会使用一个Scripting.Dictionary来跟踪已经被检查的合同号码。 这是你如何实现它。
在你做逻辑testing之后（ If rngC.Value > Now And...)检查字典中是否存在contractNum 。 这就是这条线所做的：
If Not checkedDict.Exists(contractNum) Then
- 如果评估结果为
True，那么合同还没有被检查，所以我们把它添加到字典中，并显示消息框。 - 如果评估结果为
False，那么合同确实存在于字典中，所以什么都不能做，因为用户已经被通知了到期合同。
以下是完整的代码（未经testing）：
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改为Dim checkedDict as Object 。
我总是使用AlreadyCheckedstringvariables来跟踪已经处理的内容。
在循环中添加一个像这样的检查：
Dim AlreadyChecked As String AlreadyChecked = "@" If Instr(AlreadyChecked, "@" & ValueToCheck & "@") = 0 Then AlreadyChecked = AlreadyChecked & ValueToCheck & "@" ... do your stuff ... End If