Sub bbb()
Dim arr, arr2, brr(), x As WorksheetFunction
Dim lr As Long, lc As Integer, i As Long, j As Integer, k As Integer, c As Integer, r As Integer
c = 5
Set x = WorksheetFunction
arr = ActiveSheet.UsedRange
Sheets("整理后").Cells.ClearContents
lr = 2
For i = 1 To UBound(arr)
lc = x.CountA(x.Index(arr, i, 0))
If lc > 0 Then
r = x.RoundUp(lc / c, 0)
ReDim brr(1 To r, 1 To c)
arr2 = x.Index(arr, i, 0)
For j = 1 To r
For k = 1 To c
If (j - 1) * c + k <= lc Then brr(j, k) = arr2((j - 1) * c + k)
Next k
Next j
With Sheets("整理后")
.Range("a" & lr).Resize(r, c) = brr
lr = lr + r + 2
End With
End If
Next
End Sub
zhaogong1960,您好.能否将您的代码加上注释呢,谢谢,真的有点看不懂,特别是红色的代码
[ 本帖最后由 yuan710825 于 2009-4-24 22:38 编辑 ] |