请教老师：月日时分与月日数据匹配，谢谢！

lwx228 · 发表于 2018-7-28 19:39

如题、详见附件，有劳高手！

huang1314wei · 发表于 2018-7-29 07:40

Sub test()
Dim arr, brr, i%, j%, n%, d As Object, rng As Range, rng1 As Range
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("A1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = Array(arr(i, 3), arr(i, 11), arr(i, 5), arr(i, 2), arr(i, 7), arr(i, 9))
Next
j = Sheet1.Range("A65536").End(xlUp).Row
Sheet1.Range("G2:L65536").ClearContents
Set rng = Sheet1.Range("A2:A" & j)
For Each rng1 In rng
temp = CDate(Format(rng1.Value, "yyyy/m/d"))
n = 0
Do
temp = temp - 1
n = n + 1
If d.exists(temp) Then
rng1.Offset(, 6).Resize(1, 6) = d(temp)
Exit Do
End If
Loop Until n = d.Count
Next
End Sub

复制代码

huang1314wei · 发表于 2018-7-29 08:33

本帖最后由 huang1314wei 于 2018-7-29 08:44 编辑

上面的代码逻辑有问题，作废，下面的代码没有问题了

Sub test()
Dim arr, brr, i%, j%, n%, d As Object, rng As Range, rng1 As Range, maxDate As Date
Dim maxDate2, flag As Boolean
Set d = CreateObject("scripting.dictionary")
arr = Sheet2.Range("A1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = Array(arr(i, 3), arr(i, 11), arr(i, 5), arr(i, 2), arr(i, 7), arr(i, 9))
Next
j = Sheet1.Range("A65536").End(xlUp).Row
Sheet1.Range("G2:L65536").ClearContents
Set rng = Sheet1.Range("A2:A" & j)
For Each rng1 In rng
temp = CDate(Format(rng1.Value, "yyyy/m/d"))
maxDate = temp - 1
flag = False
For Each c In d.keys
If c <= maxDate Then
If flag = False Then maxDate2 = c: flag = True
If c > maxDate2 Then
maxDate2 = c
End If
End If
Next
If flag = True Then rng1.Offset(, 6).Resize(1, 6) = d(maxDate2)
Next
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 请教老师：月日时分与月日数据匹配，谢谢！