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 結果作為三元組，而不是在三個單獨的列中，我應該誤解你了。