- Sub Macro1()
- Dim arr, brr, i&, j%, s&, x%
- arr = Range("b33").CurrentRegion
- ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2) - 1)
- y = UBound(arr)
- For j = 2 To UBound(arr, 2)
- x = arr(y, j): s = 0
- For i = y - 1 To 1 Step -1
- If arr(i, j) = x Then s = s + 1: brr(s, j - 1) = arr(i + 1, j)
- Next
- Next
- Cells(y + 36, 2).Resize(UBound(brr), UBound(brr, 2)) = brr
- End Sub
复制代码 |