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

老骥705664849

zhoubocz 发表于 2020-7-1 09:27
是用上传的附件测试的

这就没有办法了，我这里正常，你那里出问题

曹亮120

Sub test()
With Sheets("台账")

    'r = .Cells(Rows.Count, 1).End(xlUp).Row
    r = .Cells(2, 1).End(xlDown).Row
    .Range("c3:c" & r) = Empty
    ar = .Range("a1:c" & r)
    'rs = .Cells(Rows.Count, 6).End(xlUp).Row
    rs = .Cells(2, 6).End(xlDown).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

曹亮120

曹亮120 发表于 2020-7-1 09:54
Sub test()
With Sheets("台账")

看了下运行错误,ar数组会取值到[A9]单元格的时候要将空值强行转时间会报错.
改一下ar的取值范围即可.

曹亮120

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

报错的时候  i = 9    也就是ar(i,1)  是个空值   datevalue会报错

曹亮120

Sub test()
    With Sheets("台账")
        
        r = .Cells(2, 1).End(xlDown).Row
        .Range("c3:c" & r) = Empty
        ar = .Range("a3:c" & r)
        rs = .Cells(2, 6).End(xlDown).Row
        br = .Range("f3:h" & rs)
        For i = 1 To UBound(ar)
            For s = 1 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("a3:c" & r) = ar
    End With
End Sub

zhoubocz

老骥705664849 发表于 2020-7-1 09:43
这就没有办法了，我这里正常，你那里出问题

好的，还是非常感谢您！

zhoubocz

曹亮120 发表于 2020-7-1 10:02
Sub test()
    With Sheets("台账")
        

太棒了，运行不报错，而且达到了查询目的，并且查询准确，非常感谢！

曹亮120

zhoubocz 发表于 2020-7-1 10:09
太棒了，运行不报错，而且达到了查询目的，并且查询准确，非常感谢！

这段代码是在@老骥705664849的基础上改的.
你还需要测试查询是否准确,查询的逻辑我没改,我只改了个取值范围.

zhoubocz

老骥的逻辑是对的，查询结果正确的，感谢！

zhoubocz

@老骥705664849@曹亮120两位大神，还要麻烦一下，这段代码运行时当数据较多时（3000行数据以上）执行起来就非常缓慢，表格处于无反应状态，有优化的方案吗?对应大数据的处理。