请教老师，用VBA把A列的数，按每列指定多少行，来进行拆分排列,谢谢！

cartel

请教老师，用VBA把A列的数，按每列指定多少行，来进行拆分排列,谢谢！.zip (1.59 MB, 下载次数: 8)

2022-11-17 20:06 上传

点击文件名下载附件

3190496160

ub 拆分()
With Sheet1
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    w = InputBox("请输入行数", "行数", "200")
    If w = "" Then End
    m = 2
    For i = 1 To r Step w
        m = m + 1
        .Range("a" & i & ":a" & i + w - 1).Copy .Cells(1, m)
    Next i
End With
MsgBox "ok!"
End Sub

gwjkkkkk

Sub TEST()
    Dim arr, brr, iNum, i&, iTimes&, R&, t#
    Application.ScreenUpdating = False
    t = Timer
    arr = [a1].CurrentRegion
    iNum = InputBox("请输入行数", "行数", "200")
    If iNum = "" Then Exit Sub
    iTimes = -Int(-UBound(arr) / Val(iNum))
    arr = cutArray(arr, Val(iNum))
    ReDim brr(1 To Val(iNum), 1 To iTimes)
    For i = 1 To UBound(arr)
       For j = 1 To UBound(arr(i))
           brr(j, i) = arr(i)(j, 1)
       Next j
    Next i
    [C1].CurrentRegion.Clear
    [C1].Resize(UBound(brr), UBound(brr, 2)) = brr
    Application.ScreenUpdating = True
    MsgBox "执行完毕!_用时:  " & Format(Timer - t, "0.00") & "  秒", 64
End Sub
Function cutArray(ar, iCutNum&) As Variant
    Dim brr(), crr, i&, j&, iPosRow&, R&, k&
    For i = 1 To UBound(ar) Step iCutNum
        iPosRow = IIf((i + iCutNum - 1) > UBound(ar), UBound(ar) Mod iCutNum, iCutNum)
        ReDim crr(1 To iPosRow, 1 To UBound(ar, 2))
        For j = 1 To UBound(crr)
           For k = 1 To UBound(crr, 2)
               crr(j, k) = ar(i - 1 + j, k)
           Next k
        Next j
        R = R + 1
        ReDim Preserve brr(1 To R)
        brr(R) = crr
    Next i
    cutArray = brr
End Function

gwjkkkkk

请参考附件。。。