|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Option Explicit
Sub test()
Dim arr, i, j, t, dic(1), key, m
For i = 0 To UBound(dic)
Set dic(i) = CreateObject("scripting.dictionary")
Next
arr = Sheets("数据源").[a1].CurrentRegion.Offset(1).Value
For i = 1 To UBound(arr, 1) - 1
t = Split(arr(i, 2), ":")(1) & Split(arr(i, 3), ":")(1) & arr(i, 4) & arr(i, 5)
If dic(0).exists(t) Then
If dic(1)(t) > arr(i, 8) Then dic(0)(t) = i: dic(1)(t) = arr(i, 8)
Else
dic(0)(t) = i
dic(1)(t) = arr(i, 8)
End If
Next
ReDim brr(1 To dic(0).Count, 1 To UBound(arr, 2))
For Each key In dic(0).keys
m = m + 1
For j = 1 To UBound(arr, 2)
brr(m, j) = arr(dic(0)(key), j)
Next
Next
With Sheets("结果")
.[d:e].NumberFormatLocal = "@"
With .[a2]
.Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
.Resize(m, UBound(brr, 2)) = brr
End With
End With
End Sub |
评分
-
2
查看全部评分
-
|