excel vba 中多列堆叠为一列

Question

我有多列（15 到 16）数据（参见图片）。

它有一个数字，分为 3 列，例如。 147 分为三列 1、4、7，268 分为 2、6、8。 现在我想以此图像所示的方式堆叠数据

为此，我尝试将三列连接成一个数字，例如 1、4、7 组合成 147，2、6、8 组合成 268。我写的代码给出了 output 148 和 268 但是它们之间有两个空列，如图所示。

我无法堆叠这些列以获得所需的 output。请建议任何方法直接从输入堆叠到所需的 output 或者我当前代码中的任何修改，以便我在顺序列中获得连接的数据。

注意：- 行数和列数是可变的，不是 static。

Sub JoinAndCut()
Dim n As Long
Dim p, col As Long
Dim lastrow As Long
For p = 1 To 25 Step 3

lastrow = ThisWorkbook.Worksheets(2).Cells(Rows.count, p).End(xlUp).Row   '<== To Count number of rows in each column

For n = 2 To lastrow

Cells(n, p).Offset(, 25).Value = Cells(n, p).Value & Cells(n, p + 1).Value & Cells(n, p + 2).Value ' <=== Offset by 25 values so as they dont overlap the input

Next n
Next p

End Sub


Sub JoinAndCut()
Dim n As Long
Dim p, col As Long
Dim lastrow As Long
For p = 1 To 25 Step 3

lastrow = ThisWorkbook.Worksheets(2).Cells(Rows.count, p).End(xlUp).Row   '<== To Count number of rows in each column

For n = 2 To lastrow

Cells(n, p).Offset(, 25).Value = Cells(n, p).Value & Cells(n, p + 1).Value & Cells(n, p + 2).Value ' <=== Offset by 25 values so as they dont overlap the input

Next n
Next p

End Sub

Answer 1

你可以试试这个：

Sub JoinAndCut()
    Dim n As Long
    Dim p, col As Long
    Dim lastrow As Long, lastrowstack As Long
    For p = 1 To 25 Step 3

        lastrow = ThisWorkbook.Worksheets(2).Cells(Rows.Count, p).End(xlUp).Row   '<== To get row number in each column
        lastrowstack = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 26).End(xlUp).Row   '<== To get row number in in the stacked column

        For n = 2 To lastrow
            
            Cells(n + lastrowstack - 1, 26).Value = Cells(n, p).Value & Cells(n, p + 1).Value & Cells(n, p + 2).Value ' <=== Starting in column 26 so as they dont overlap the input

        Next n
    Next p

End Sub

假设你有这样的事情：

html格式的数据

然后，您可以将它们合并并堆叠在 Z 列（又名第 26 列）中，前 36 行看起来像这样。

Answer 2

如果我理解你想要的是正确的，这是一个三列表，每列有一个值，那么以下内容应该有所帮助。

我选择使用Power Query （Excel 2010+可用）

算法：

• 取消透视所有列：
  • 2 列中的结果由列 header 和值组成
• 添加一个索引列，然后添加一个整数/除法列，我们将索引列除以 3。
  • 这将返回一列0,0,0,1,1,1,2,2,2, ...
• 按Integer/Divide列分组
• 将结果表中的值提取到分隔符分隔的列表中。
• 将列表拆分为列。
• 删除不需要的列，我们就完成了。
• 如果您添加或删除列/行和Refresh ， output 表将反映出来。

我建议你

• Select data.table 中的一个单元格
• 输入电源查询
  • Excel 2016+， Data-->Get&Transform-->From Table/Range
    • 在其他版本中，您可以从 MS 安装一个免费的插件并按照这些说明进行操作
• 在 PQ UI 中，go 到Home/Advanced Editor
  • 注意第 2 行中的Table名
  • 删除编辑器的内容，将下面的M代码粘贴到它的位置
    • 更改第 2 行中的表名以匹配您的真实表名。
  • 检查应用步骤 window 以更好地了解每个步骤的执行情况。
    • 双击带有settings gear icon的步骤以显示选项

M代码

let
    Source = Excel.CurrentWorkbook(){[Name="Table5"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {}, "Attribute", "Value"),
    #"Added Index1" = Table.AddIndexColumn(#"Unpivoted Other Columns", "Index", 0, 1),
    #"Inserted Integer-Division" = Table.AddColumn(#"Added Index1", "Integer-Division", each Number.IntegerDivide([Index], 3), Int64.Type),
    #"Removed Columns1" = Table.RemoveColumns(#"Inserted Integer-Division",{"Index", "Attribute"}),
    #"Grouped Rows" = Table.Group(#"Removed Columns1", {"Integer-Division"}, {{"Grouped", each _, type table [Value=number, #"Integer-Division"=number]}}),
    #"Removed Columns" = Table.RemoveColumns(#"Grouped Rows",{"Integer-Division"}),
    #"Added Custom" = Table.AddColumn(#"Removed Columns", "Column", each Table.Column([Grouped],"Value")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Column", each Text.Combine(List.Transform(_, Text.From), ";"), type text}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Extracted Values", "Column", Splitter.SplitTextByDelimiter(";", QuoteStyle.Csv), {"Column.1", "Column.2", "Column.3"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Column.1", Int64.Type}, {"Column.2", Int64.Type}, {"Column.3", Int64.Type}}),
    #"Removed Columns2" = Table.RemoveColumns(#"Changed Type",{"Grouped"})
in
    #"Removed Columns2"

原始数据

结果

如果在 VBA 中执行此操作是绝对必要的，您可以尝试此代码：但通读它以便您可以适当地更改范围和工作表引用：

Option Explicit
Sub JoinAndCut()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range, col As Collection, vSrc, vRes
    Const firstRow As Long = 31
    Const firstCol As Long = 1
    Dim I As Long, J As Long, K As Long, arr(0 To 2), v
    
'read the data into VBA array
Set wsSrc = ThisWorkbook.Worksheets("sheet9")
With wsSrc
    vSrc = .Cells(firstRow, firstCol).CurrentRegion
End With

'collect output array
Set col = New Collection
For I = 2 To UBound(vSrc, 1) 'skip the header row
    For J = 1 To UBound(vSrc, 2) Step 3
        For K = 0 To 2
            arr(K) = vSrc(I, J + K)
        Next K
        If arr(0) <> "" Then col.Add arr 'skip the blanks
    Next J
Next I

'Create results array
ReDim vRes(0 To col.Count, 1 To 3)

'Headers
vRes(0, 1) = "Column.1"
vRes(0, 2) = "Column.2"
vRes(0, 3) = "Column.3"

'Populate
I = 0
For Each v In col
    I = I + 1
    For J = 1 To 3
        vRes(I, J) = v(J - 1)
    Next J
Next v

'Set output range
Set wsRes = wsSrc
    Set rRes = wsRes.Cells(50, 1)
    Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
    
    With rRes
        .ClearContents
        .Value = vRes
      'could add formatting commands
    End With
End Sub

以上任何一项都可以很容易地修改为 output 结果作为三元组，而不是在三个单独的列中，我应该误解你了。