|
Sub 练习() '雄鹰2017.10.19
Dim arr, brr, ar, br, cr
Set d = CreateObject("scripting.dictionary")
arr = Sheets("原始数据").[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr)
If VBA.IsNumeric(arr(i, 3)) Then x = Format(arr(i, 3), "hh:mm:ss") Else x = arr(i, 3)
x = Format(arr(i, 2) & " " & x, "0.000000") '注意精度
If arr(i, 1) <> "" Then
d(arr(i, 1)) = x
Else
arr(i, 1) = arr(i - 1, 1)
d(arr(i - 1, 1)) = d(arr(i - 1, 1)) & "," & x
End If
Next i
For Each k In d.keys
ar = Split(d(k), ",")
ReDim br(0 To UBound(ar))
For i = 0 To UBound(ar)
br(i) = CDbl(ar(i))
Next i
y = Application.Max(br)
cr = Split(CDate(y), " ")
n = n + 1
brr(n, 1) = k
brr(n, 2) = cr(0)
brr(n, 3) = cr(1)
Next k
Sheets("结果").[a15].Resize(n, 3) = brr
End Sub |
|