每当值重复时，将 1 天添加到今天的日期 [英] Add 1 day to todays date whenever value gets repeated

问题描述

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

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

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

<预><代码>子 Add_date2()将 lastRow 调暗至长Dim matchFoundIndex As LongDim iCntr 长lastRow = Range("A65000").End(xlUp).Row对于 iCntr = 2 到 lastRow如果 Cells(iCntr, 1) <>"然后matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)如果 iCntr <>matchFoundIndex 然后单元格(iCntr, 2) = 日期 + 1别的单元格(iCntr, 2) = 日期万一万一下一个结束子

解决方案

Use Application.Countifs:

 Sub Add_date2()Dim ws as 工作表Set ws = ActiveSheet '更好地设置实际工作表 WorkSheets("Sheet1")与 ws将 lastRow 调暗至长lastRow = .Cells(Rows.Count, 1).End(xlUp).RowDim iCntr 长对于 iCntr = 2 到 lastRow如果 .Cells(iCntr, 1) <>"然后.Cells(iCntr, 2) = Date + Application.CountIfs(.Range(.Cells(2, 1), .Cells(iCntr, 1)), .Cells(iCntr, 1)) - 1万一下一个结束于结束子

I have a problem that I hope you can help me with.

The below code adds 1 day to todays day in Column B if it finds a repeated value in column A. However I want it to add 2 days if it gets repeated again and so on.

I have tried to illustrate how the codes work in the attached picture. So what I want is cell B10 in the picture to be 20/03/2021. I need to make it automatic so it can run for any number of repeated values.

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

解决方案

Use 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

这篇关于每当值重复时，将 1 天添加到今天的日期的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！