excel - 在excel中一次堆叠5列离散列

Question

我有 7 组 5 列具有相似的数据。目前，我手动将每个 5 列集合复制并粘贴到前一组下方，以便所有 7 列都在 5 列中。我需要一个宏来改变它：

进入这个：

任何人都可以帮忙吗？

这个宏非常适合将多列堆叠成一列，但我不能让它一次为 5 列工作：

Sub CombineColumns()
Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer

Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1

For iCol = 2 To rng.Columns.Count
    Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
    ActiveSheet.Paste Destination:=Cells(lastCell, 1)
    lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
End Sub

标签： excelvbaoffice365

Answer 1

尝试：

Sub test()
Dim MiMatriz As Variant
Dim FinalArray As Variant
Dim i As Long
Dim zz As Long
Dim PosSet As Long
Dim rngDestiny As Range

Set rngDestiny = Range("A14") 'Change this to top left cell of data destiny


MiMatriz = Range("A1").CurrentRegion.Value 'A1 is top left cell of complete dataset

ReDim FinalArray(1 To Range("A1").CurrentRegion.Columns.Count + 1, 1 To 5) As Variant

For zz = 1 To 5 Step 1
    PosSet = 0
    Do Until 1 + PosSet > UBound(FinalArray) - 1
        For i = 2 To 6 Step 1
            FinalArray(i + PosSet, zz) = MiMatriz(i, zz + PosSet)
        Next i
        PosSet = PosSet + 5
    Loop
Next zz

'add headers in index 1

FinalArray(1, 1) = "Title 1"
FinalArray(1, 2) = "Title 2"
FinalArray(1, 3) = "Title 3"
FinalArray(1, 4) = "Title 4"
FinalArray(1, 5) = "Title 5"

'paste data
rngDestiny.Resize(UBound(FinalArray), 5).Value = FinalArray

Erase FinalArray, MiMatriz
End Sub

这是它的工作原理：