如何使用VBA在Excel中堆叠列?

tvz2xvvm  于 2023-03-09  发布在  其他
关注(0)|答案(2)|浏览(140)

目前我是第一次使用VBA。
我收到了一个任务,我需要使用VBA在MS Excel中堆叠以下列。

结果应如下所示:

我在网上找到了以下VBA脚本(来源:https://www.extendoffice.com/documents/excel/4233-excel-stack-columns.html):

Sub ConvertRangeToColumn()
'UpdatebyExtendoffice
    Dim Range1 As Range, Range2 As Range, Rng As Range
    Dim rowIndex As Integer
    xTitleId = "KutoolsforExcel"
    Set Range1 = Application.Selection
    Set Range1 = Application.InputBox("Source Ranges:", xTitleId, 
    Range1.Address, Type:=8)
    Set Range2 = Application.InputBox("Convert to (single cell):", xTitleId, Type:=8)
    rowIndex = 0
    Application.ScreenUpdating = False
    For Each Rng In Range1.Rows
        Rng.Copy
        Range2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
        rowIndex = rowIndex + Rng.Columns.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

执行脚本会导致以下结果

没想到破折号会在“栈底”。
如果有人能告诉我为什么会这样,以及我如何解决这个问题,我将非常感激。
非常感谢提前!

vc6uscn9

vc6uscn91#

迭代列,但不转置粘贴。

Option Explicit
Sub ConvertRangeToColumn()
    Dim rng1 As Range, rng2 As Range, rng As Range
    Dim rowIndex As Integer
    
    Set rng1 = Application.InputBox("Source Ranges:", "Select range", Selection.Address, Type:=8)
    Set rng2 = Application.InputBox("Convert to (single cell):", "Select range", Type:=8)
    rowIndex = 0
    Application.ScreenUpdating = False
    
    For Each rng In rng1.Columns
        rng.Copy
        rng2.Offset(rowIndex, 0).PasteSpecial Paste:=xlPasteAll
        rowIndex = rowIndex + rng.Rows.Count
    Next
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
mtb9vblg

mtb9vblg2#

由于您的标记不包含任何版本限制,因此可以使用公式来执行此操作:

=TEXTSPLIT(TEXTJOIN("~",TRUE,TRANSPOSE(Table2[#All])),,"~")

或者,如果不想使用

=TEXTSPLIT(TEXTJOIN("~",TRUE,TRANSPOSE(cell_Range_reference),,"~")

相关问题