Сложите несколько столбцов в один столбец в excel vba

Question

У меня есть несколько столбцов (от 15 до 16) данных ( см. Изображение ).

Он имеет одно число, которое разделено на 3 столбца Например. 147 разделен на три столбца 1, 4, 7 и 268 разделен на 2,6,8. Теперь я хочу сложить данные так, как показано на этом изображении

Для этого я попытался объединить три столбца, чтобы сделать один di git, например 1,4, 7 объединяются в форму 147, а 2,6,8 объединяются в форму 268. Код, который я написал, дал выходные данные 148 и 268, но между ними есть два пустых столбца, показанных как this .

Я не могу сложить эти столбцы, чтобы получить желаемый результат. Пожалуйста, предложите любой метод для прямого стека от ввода к желаемому выводу или любую поправку в моем текущем коде, чтобы я получал сцепленные данные в последовательных столбцах.

Примечание: - Количество строк и столбцов является переменным, а не статическим c.

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

Если я правильно понимаю, что вы хотите, а именно таблицу из трех столбцов с одним значением в каждом столбце, следующее должно помочь.

Я решил использовать Power Query (доступно в Excel 2010+)

Алгоритм:

• Развернуть все столбцы:
  • Результаты в 2 столбцах, состоящих из заголовка столбца и значения
• Добавьте столбец индекса, а затем добавьте столбец Integer / Divide , в котором мы делим столбец индекса на 3.
  • Это возвращает столбец 0,0,0,1,1,1,2,2,2, ...
• Группировать по столбцу Integer/Divide
• Извлечь значения из результирующей таблицы в список, разделенный разделителями.
• Разделить список в столбцы.
• Удалите ненужные столбцы, и все готово.
• Если вы добавите или удалите столбцы / строки и Refre sh, выходная таблица будет отразите это.

Я предлагаю вам

• Выберите ячейку в таблице данных
• Введите Power Query
  • В Excel 2016+, Data-->Get&Transform-->From Table/Range
    • В других версиях вы устанавливаете бесплатную надстройку от MS и следуете этим указаниям
• В пользовательском интерфейсе PQ от go до Home/Advanced Editor
  • Обратите внимание на имя Table в строке 2
  • Удалите содержимое редактора и вставьте M-код ниже на свое место
    • Измените имя таблицы в строке 2, чтобы оно соответствовало вашему настоящему имени таблицы.
  • Изучите окно Applied Steps, чтобы лучше видеть, что делается на каждом этапе.
    • дважды щелкните шаги с 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"

Исходные данные

Results

введите описание изображения здесь

Если выполнение этого в 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

Либо один из приведенных выше вариантов можно легко изменить для вывода результатов в виде троек, а не в трех отдельных столбцах, если я вас неправильно понял.

Answer 2

Вы можете попробовать это:

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 строк будут выглядеть следующим образом .