'假设D列有序,,,
Option Explicit
Sub test()
Dim arr, i, j, m, p, sum, max
arr = [d17].CurrentRegion.Offset(1).Resize(, 4).Value
ReDim brr(1 To UBound(arr, 1), 1 To 30)
For i = 1 To UBound(arr, 1) - 1
sum = sum + arr(i, 4)
If arr(i, 1) <> arr(i + 1, 1) Then
m = m + 3
brr(m - 2, 1) = arr(i, 1): brr(m - 2, 2) = sum: brr(m - 2, 3) = arr(i, 3)
For j = p + 1 To i
brr(m - 1, j - p) = arr(j, 2): brr(m, j - p) = arr(j, 4)
Next
If max < i - p Then max = i - p
p = i: sum = 0
End If
Next
With [j21]
.Resize(m + 1, max + 1).Clear
With .Resize(m, max)
.Borders.LineStyle = xlContinuous
.Value = brr
End With
End With
End Sub |