大神们救救我吧

lyfshe1022

表格内需要标注出同一个人在登记之日起每30天内重复登记的行感谢万分

3190496160

Sub 标记()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 7 Then MsgBox "请在【基本信息设置】中设置年级名称，班级数和开始班级名称！": End
    .Range("c2:c" & r) = Empty
    ar = .Range("a1:c" & r)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            d(Trim(ar(i, 1))) = i
        End If
    Next i
    Dim br()
    For Each k In d.keys
        n = 0
        ReDim br(1 To UBound(ar), 1 To 1)
        For i = 2 To UBound(ar)
            If Trim(ar(i, 1)) = k Then
                n = n + 1
                'br(n, 1) = ar(i, 1)
                br(n, 1) = CDate(Format(ar(i, 2), "yyyy/m/d"))
            End If
        Next i
        For i = 1 To n
            For s = i + 1 To n
                If DateValue(br(i, 1)) > DateValue(br(s, 1)) Then
                    kk = br(i, 1)
                    br(i, 1) = br(s, 1)
                    br(s, 1) = kk
                End If
            Next s
        Next i
        zd = br(n, 1)
        zx = br(1, 1)
        ts = DateDiff("d", zx, zd)
        If ts <= 30 Then
            xh = d(k)
            ar(xh, 3) = "重复"
        End If
    Next k
    .[c1].Resize(UBound(ar), 1) = Application.Index(ar, 0, 3)
End With

End Sub

3190496160

测试.rar (16.13 KB, 下载次数: 7)

2022-7-4 22:51 上传

点击文件名下载附件

Excel表哥在此

附件供参考：