|
原来代码默认频是从大到小排好序的,现在重新更改代码:
- Sub test()
- Dim i&, j%, k&, d, arr, brr()
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("Sheet1")
- arr = .UsedRange.Value
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
- k = 0
- For i = 2 To UBound(arr)
- If Not d.Exists(arr(i, 1)) Then
- k = k + 1
- d(arr(i, 1)) = Array(k, Val(arr(i, 2)))
- For j = 1 To UBound(arr, 2)
- brr(k, j) = arr(i, j)
- Next
- Else
- If d(arr(i, 1))(1) < Val(arr(i, 2)) Then
- d(arr(i, 1)) = Array(d(arr(i, 1))(0), Val(arr(i, 2)))
- For j = 1 To UBound(arr, 2)
- brr(d(arr(i, 1))(0), j) = arr(i, j)
- Next
- End If
- End If
- Next
- .Range("A2:F" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1).ClearContents
- .[A2].Resize(k, UBound(brr, 2)) = brr
- End With
- End Sub
复制代码
|
|