VBA - 如果> 2标记最接近当前日期的日期，则计算重复值

Question

我想要的脚本是计算列中的重复值，如果值大于 2，则根据最接近当前日期的日期列将其标记为“已更新”到最后一列。

示例:

Column A | Column B | Column C
   1     | 1/2/2016 |
   2     | 1/3/2016 |
   3     | 1/4/2016 |
   1     | 1/5/2016 |
   1     | 1/6/2016 |  

输出:

Column A | Column B | Column C
       1 | 1/2/2016 |
       2 | 1/3/2016 |
       3 | 1/4/2016 |
       1 | 1/5/2016 |
       1 | 1/6/2016 |  updated

在此示例中，值 1在Column A具有重复值 >2所以在 Column C这是最后一列，它将被标记为 updated ...有三个1在Column A但现在最接近的日期是 1/6/2016所以它就是被标记的... if <2未执行任何操作..

这是我的代码:

 Sub sbFindDuplicatesInColumn_C()

 Dim lastRow As Long
 Dim countRow As Long
 Dim iCntr As Long
 Dim CurDate As Date

 lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

     For iCntr = 1 To lastRow

         If Cells(iCntr, 1) > 3 Then

         countRow = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)

     If iCntr <> countRow Then

     If CurDate <> iCntr Then

    Cells(iCntr, 3) = "Updated"

 End If
 End If
 End If
 Next

 End Sub

我的代码无法正常工作，但没有给出任何错误。

Answer 1

您的叙述与您的样本结果相矛盾，因为任何数据都不“大于 3”。我假设这是一个拼写错误，您的意思是“大于 2”。

一个WorksheetFunction object的COUNTIF function可以轻松确定 A 列中值的频率。虽然可以计算数组公式来确定 B 列中的最大日期，但实际上您只想确定是否有比所检查的日期晚的日期。如果没有，你有最新的日期。一个COUNTIFS function可以比数组公式更快地确定这一点。

Sub sbFindDuplicatesInColumn_C()
    Dim i As Long, lastRow As Long, countRow As Long

    With Worksheets("Sheet2")   '<~~ you should know what worksheet you are on!!
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To lastRow
            countRow = Application.CountIf(.Columns(1), .Cells(i, 1))
            If countRow > 2 Then
                If Not CBool(Application.CountIfs(.Columns(1), .Cells(i, 1), _
                                        .Columns(2), ">" & .Cells(i, 2))) Then _
                    .Cells(i, 3) = "updated"
            End If
        Next i
    End With

End Sub