将一列分成多列

Question

所以....我迷路了，我对VBA一无所知...所以我想做的是从B2：B列中复制表格“PasteHere”中的数据并将其分成多个“分隔线”上的列从 C.. 开始，不超过 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