求如何将最小日期提取按姓名匹配，感谢各位老师！

帕帕基诺

各位老师好！

      我需要将《计划日期》这张表里每个人设定的那个对应其各自姓名的最早的那个日期，匹配到《参加计划人员名单》各自的姓名所对应的那一行。因为每个人设定的计划个数有多有少、计划日期各自不一样，我到现在没有思路不知道怎么写，有些着急，请哪位老师给我这个小白指点一下该怎么写这一段代码！感激不尽！附件是两张表

3190496160

Sub 匹配()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "计划日期.xlsx")
If f = "" Then MsgBox "找不到计划日期文件": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    br = .Range("a1:b" & rs)
End With
wb.Close False
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    If r < 2 Then MsgBox "目标表为空！": End
    .Range("b2:b" & r) = Empty
    ar = .Range("a1:b" & r)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" Then
            rq = "2095/1/1"
            For s = 2 To UBound(br)
                If Trim(br(s, 1)) = Trim(ar(i, 1)) Then
                    If br(s, 2) <= rq Then
                        rq = br(s, 2)
                    End If
                End If
            Next s
            If rq <> "2095/1/1" Then ar(i, 2) = rq
        End If
    Next i
    .Range("a1:b" & r) = ar
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

参考
如何提取同一名称下最早的日期.rar (35.2 KB, 下载次数: 7)

2022-12-6 09:52 上传

点击文件名下载附件

帕帕基诺

3190496160 发表于 2022-12-6 09:51
Sub 匹配()
Application.ScreenUpdating = False
Dim ar As Variant

非常感谢老师的帮助，您的代码非常非常有用，感激不尽！！！！