Option Explicit
Sub test()
Dim arr, i, j, k, kk, n
arr = Range("a1:e" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
ReDim brr(1 To Rows.Count, 1 To UBound(arr, 2))
For i = 1 To UBound(arr, 1) - 1
For j = i To UBound(arr, 1) - 1
If arr(j, 1) <> arr(j + 1, 1) Then
n = n + 1
For k = 1 To UBound(arr, 2): brr(n, k) = arr(i, k): Next
For k = i + 1 To j
For kk = 1 To arr(k, 2) - arr(k - 1, 2) - 1
n = n + 1
brr(n, 1) = arr(i, 1): brr(n, 2) = brr(n - 1, 2) + 1
Next
n = n + 1
For kk = 1 To UBound(arr, 2): brr(n, kk) = arr(k, kk): Next
Next
i = j: Exit For
End If
Next j, i
With [i1]
.Resize(Rows.Count, UBound(brr, 2)).ClearContents
.Resize(n, UBound(brr, 2)) = brr
End With
End Sub |
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-7-3 11:35
