根据日期条件进行重复值的精确匹配

zhoubocz

请各位大神指教日常工作中的难题，具体如下：





附件已添加，请指教

老骥705664849

Sub test()
With Sheets("台账")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("c3:c" & r) = Empty
    ar = .Range("a1:c" & r)
    rs = .Cells(Rows.Count, 6).End(xlUp).Row
    br = .Range("f1:h" & r)
    For i = 3 To UBound(ar)
        For s = 3 To UBound(br)
            If Trim(ar(i, 2)) = Trim(br(s, 2)) And DateValue(ar(i, 1)) > DateValue(br(s, 1)) And br(s, 3) > 0 Then
                ar(i, 3) = br(s, 1)
            End If
        Next s
    Next i
     .Range("a1:c" & r) = ar
End With
End Sub

zhoubocz

老骥705664849 发表于 2020-6-30 15:39
Sub test()
With Sheets("台账")
    r = .Cells(Rows.Count, 1).End(xlUp).Row

运行代码会报错
Sub test()
With Sheets("???")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("c3:c" & r) = Empty
    ar = .Range("a1:c" & r)
    rs = .Cells(Rows.Count, 6).End(xlUp).Row
    br = .Range("f1:h" & r)
    For i = 3 To UBound(ar)
        For s = 3 To UBound(br)
            If Trim(ar(i, 2)) = Trim(br(s, 2)) And DateValue(ar(i, 1)) > DateValue(br(s, 1)) And br(s, 3) > 0 Then
                ar(i, 3) = br(s, 1)
            End If
        Next s
    Next i
     .Range("a1:c" & r) = ar
End With
End Sub

老骥705664849

代码是没有问题的，应该是你电脑右下角显示的系统日期带星期，调整系统日期格式只显示年月日即可

zhoubocz

老骥705664849 发表于 2020-6-30 16:05
代码是没有问题的，应该是你电脑右下角显示的系统日期带星期，调整系统日期格式只显示年月日即可

是没带日期呢

zhoubocz

老骥705664849

zhoubocz 发表于 2020-6-30 17:48

我这里运行是正常的，你那里如何提示？？

zhoubocz

老骥705664849 发表于 2020-6-30 18:11
我这里运行是正常的，你那里如何提示？？

这样的提示

老骥705664849

zhoubocz 发表于 2020-7-1 08:51
这样的提示

针对你上传的附件，在我这里是能够正常运行的，至于你那里出现错误，不得而知，你是用你上传的附件测试出现错误，还是用真是的数据测试出现错误，楼主具体情况什么都不说，让别人才来猜去，

zhoubocz

老骥705664849 发表于 2020-7-1 09:23
针对你上传的附件，在我这里是能够正常运行的，至于你那里出现错误，不得而知，你是用你上传的附件测试出 ...

是用上传的附件测试的