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，因此它被标记为...如果<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

Answer 2

作为替代解决方案

Option Explicit

Sub sbFindDuplicatesInColumn_C2()

With ThisWorkbook.Worksheets("duplicates")   '<~~ you should know what workbook and worksheet you are on!!
    With .Range("A1").Offset(, 2).Resize(.Range("A" & .Rows.Count).End(xlUp).Row)
        .FormulaR1C1 = "=IF(COUNTIF(C1,RC[-2])>2, IF(COUNTIFS(C1, RC[-2],C2," & """" & ">" & """" & "&" & "RC[-1])=0," & """" & "updated" & """" & "," & """" & """" & ")," & """" & """" & ")"
        .Value = .Value '<== if you want to get rid of formulas
    End With
End With

End Sub

它与Jeeped的不同之处在于它不会遍历细胞。但是它会在每个单元格中写入两次（第一次将公式放入其中，第二次将其更改为仅保留所需标记的值），尽管仅在两个语句中。

可以知道哪个是最快的

VBA - 如果＆gt;计算重复值2标记最接近curdate的日期

2 个答案: