请测试下一个解决方案/代码。由于您没有回答澄清问题，因此假定显示的列为“A：D”，列“B：D”中的时间格式为Date（"hh:mm:ss"）。代码使用字典来保存唯一的序列号，并计算/存储第二列的最小值和第四列的最大值。序列号可以以任何顺序出现：

Sub ExtractMinMaxDates()
   Dim sh As Worksheet, lastR As Long, i As Long, arr, arrEl, arrFin
   Dim key As Variant, dict As Object
   
   Set sh = ActiveSheet 'use here the necessary sheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
   
   arr = sh.Range("A2:D" & lastR).Value2 'place the range in an array for faster iteration/processing
   
   Set dict = CreateObject("Scripting.Dictionary") 'set the necessary dictionary
   For i = 1 To UBound(arr)    'iterate between the array rows
        If Not dict.Exists(arr(i, 1)) Then 'if a dictionary key has not been created:
            dict.Add arr(i, 1), Array(arr(i, 2), arr(i, 4)) 'make it and place (as item) an array containing
        Else                                                'time from columns 2 and 4
            arrEl = dict(arr(i, 1))                         'place the item in an array
            If arr(i, 2) < arrEl(0) Then arrEl(0) = arr(i, 2) 'keep the minimum
            If arr(i, 4) > arrEl(1) Then arrEl(1) = arr(i, 4) 'keep the maximum
        End If
   Next i
   'Redim the final array to keep the dictionary data:
   ReDim arrFin(1 To dict.count, 1 To 3): i = 1

   'fill the final aray with the necesssary data
   For Each key In dict.Keys
        arrFin(i, 1) = key: arrFin(i, 2) = dict(key)(0)
        arrFin(i, 3) = dict(key)(1): i = i + 1
   Next
   
   'Drop the array content at once anf format the necessary columns:
   With sh.Range("F2").Resize(dict.count, 3) 'it may return anywhere (just change "F2" with needed cell)
        .Value2 = arrFin
        .Columns(2).EntireColumn.NumberFormat = "hh:mm:ss"
        .Columns(3).EntireColumn.NumberFormat = "hh:mm:ss"
  End With
End Sub

请在测试后发送一些反馈。