vba - 每当值重复时，将 1 天添加到今天的日期

Question

我有一个问题希望你能帮助我。

如果下面的代码在 A 列中找到重复值，则在 B 列中将 1 天添加到今天。但是，如果再次重复，我希望它添加 2 天，依此类推。

我试图在附图中说明代码是如何工作的。所以我想要的是图片中的单元格 B10 是 20/03/2021。我需要让它自动运行，这样它就可以运行任意数量的重复值。

Sub Add_date2()

    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row

    For iCntr = 2 To lastRow
    
    If Cells(iCntr, 1) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
        
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 2) = Date + 1

        Else
            Cells(iCntr, 2) = Date
        End If
        
    End If
    
    Next
    
End Sub

标签： vbadateoptimization

Answer 1

使用 Application.Countifs：

    Sub Add_date2()
    
        
        Dim ws As Worksheet
        Set ws = ActiveSheet 'better to set the actual sheet WorkSheets("Sheet1")
        
        With ws
            Dim lastRow As Long
            lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        
            Dim iCntr As Long
            For iCntr = 2 To lastRow
                If .Cells(iCntr, 1) <> "" Then
                    .Cells(iCntr, 2) = Date + Application.CountIfs(.Range(.Cells(2, 1), .Cells(iCntr, 1)), .Cells(iCntr, 1)) - 1
                End If
            Next
        End With
        
    End Sub