excel макросы для вставки нескольких столбцов данных под одной колонкой

В excel данные находятся в следующем формате,

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

Но мне нужны данные в следующем формате,

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

Может кто-то помочь мне в создании макросов для этого.

Я использовал макрос ниже, но он не работает,

Sub CombineColumns1() 'updateby Extendoffice 20151030 Dim xRng As Range Dim i, j As Integer Dim xLastRow As Integer Dim xTxt As String On Error Resume Next xTxt = Application.ActiveWindow.RangeSelection.Address Set xRng = Application.InputBox("please select the data range", "Kutools for Excel", xTxt, , , , , 8) If xRng Is Nothing Then Exit Sub xLastRow = xRng.Columns(1).Rows.Count + 1 For i = 4 To xRng.Columns.Count For j = 1 To 3 Range(xRng.Cells(j, i), xRng.Cells(xRng.Columns(i).Rows.Count, i)).Cut ActiveSheet.Paste Destination:=xRng.Cells(xLastRow, 1) xLastRow = xLastRow + xRng.Columns(i).Rows.Count Next j = 1 i = i + 2 Next End Sub 

Для формулы я помещаю исходные данные в строки 1 и 2. Затем в строке 4 я помещаю только три заголовка.

Тогда в A5 я ставлю эту формулу:

 =INDEX($2:$2,((ROW(1:1) - 1) * 3) + 1 + (COLUMN(A:A)-1)) 

Затем перетащите / заполните два столбца и опустите два ряда.

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

Если шаблон данных отличается от каждых трех столбцов, измените значение 3 на количество столбцов в шаблоне.

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


Согласно вашим комментариям:

 =IFERROR(INDEX($2:$4,INT((ROW(1:1)-1)/(MATCH("ZZZ",$1:$1)/3))+1,(MOD((ROW(1:1)-1),MATCH("ZZZ",$1:$1)/3) *3)+1 + (COLUMN(A:A)-1)),"") 

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


Чтобы сначала проложить строки, столбцы перевернули две ссылки на строки:

 =INDEX($2:$4,MOD(ROW(1:1)-1,3)+1,INT((ROW(1:1)-1)/3)*3+1+COLUMN(A:A)-1) 

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

Решение VBA (на всякий случай, если вы решите не идти с отличной формулой Скотта):

 Sub CombineColumns1() Dim xRng As Range Dim i As Long, j As Integer Dim xNextRow As Long Dim xTxt As String On Error Resume Next With ActiveSheet xTxt = .RangeSelection.Address Set xRng = Application.InputBox("please select the data range", "Kutools for Excel", xTxt, , , , , 8) If xRng Is Nothing Then Exit Sub j = xRng.Columns(1).Column For i = 4 To xRng.Columns.Count Step 3 'Need to recalculate the last row, as some of the final columns may not have data in all rows xNextRow = .Cells(.Rows.Count, j).End(xlUp).Row + 1 .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Copy .Cells(xNextRow, j) .Range(xRng.Cells(1, i), xRng.Cells(xRng.Rows.Count, i + 2)).Clear Next End With End Sub 

Примечание. В коде предполагается, что пользователь не включает заголовки при выборе диапазона данных.

  • макрос excel timer не работает, «макрос не может быть найден или макросы не включены»
  • Excel VBA: Changin concatenate, mid и найти формулы для кода VBA
  • Макрос VBA для изменения цвета ячейки, которая меняет значение в течение 1 секунды
  • Loop для запуска макросов из других книг
  • VBA Excel Добавление инкрементного текста, который также исключает пробелы
  • Рабочая книга с макросъемкой только для чтения
  • Объединение столбцов в макрос
  • Как удалить значения lates в диапазоне, который я скопировал с помощью макроса VBA?
  • открыть файл в Visual Basic в Excel Macro
  • Ссылка на именованный рабочий лист и ячейку VBA
  • Вычислить среднее значение VBA из динамической таблицы
  • Давайте будем гением компьютера.