将1列分成多个

Question

所以......我迷路了，关于VBA的任何事情我都不了解...所以我想做的是从B2：B列的“ PasteHere”表中复制数据并将其从C ..上划分为“ Divider”上的多列，且长度不超过5k行

Sub Divider()
    Dim rng As Range
    Dim InputRng As Range
    Dim OutputRng As Range
    Dim xRow As Long
    Dim xCol As Long
    Dim xArr As Variant

    Set InputRng = ThisWorkbook.Worksheets("PasteHere")
    InputRng.Columns("B2:B").EntireColumn.AutoFit

    xRow = InputRng.UsedRange.Rows.Count

    Set OutputRng = Worksheets("Divider").Columns(3)
    xCol = xRow / 5000



    ReDim xArr(1 To xRow, 1 To xCol + 1)
    For i = 0 To InputRng.Cells.Count - 1
        xValue = InputRng.Cells(i + 1)
        iRow = i Mod xRow
        iCol = VBA.Int(i / xRow)
        xArr(iRow + 1, iCol + 1) = xValue
    Next
    OutputRng.Resize(UBound(xArr, 1), UBound(xArr, 2)).Value = xArr

End Sub

Answer 1

尝试此代码

Sub Test()
    Dim a, b(), ws As Worksheet, sh As Worksheet, noRows As Long, noCols As Long, cnt As Long, i As Long, j As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("PasteHere")
        Set sh = ThisWorkbook.Worksheets("Divider")
        With ws
            a = .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
        End With
        noRows = 7
        noCols = UBound(a, 1) / noRows + 1
        ReDim b(1 To noRows, 1 To noCols)
        For i = 1 To noCols
            For j = 1 To noRows
                cnt = cnt + 1
                If cnt <= UBound(a, 1) Then
                    b(j, i) = a(cnt, 1)
                End If
            Next j
        Next i
        sh.Range("C1").Resize(noRows, noCols).Value = b
    Application.ScreenUpdating = True
End Sub