- Sub Macro1()
- Dim arr, brr, d, i&, j%, s&
- Set d = CreateObject("scripting.dictionary")
- arr = [c4:g16]
- ReDim brr(1 To UBound(arr), 1 To (UBound(arr, 2) - 2) * 2 + 1)
- For i = 2 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then
- s = s + 1
- brr(s, 1) = arr(i, 1)
- d(arr(i, 1)) = s
- For j = 3 To UBound(arr, 2)
- brr(s, (j - 2) * 2) = arr(i, j)
- brr(s, (j - 2) * 2 + 1) = arr(i, j)
- Next
- Else
- n = d(arr(i, 1))
- For j = 3 To UBound(arr, 2)
- If arr(i, j) > brr(n, (j - 2) * 2) Then brr(n, (j - 2) * 2) = arr(i, j)
- If arr(i, j) < brr(n, (j - 2) * 2 + 1) Then brr(n, (j - 2) * 2 + 1) = arr(i, j)
- Next
- End If
- Next
- Range("h5").Resize(UBound(brr), UBound(brr, 2)) = brr
- End Sub
复制代码 |