Транспонирование данных с использованием VBA с заголовками [duplicate]

Решение VBA может быть неприемлемым в некоторых ситуациях (например, невозможно встроить макрос из соображений безопасности и т. д.). Для этих ситуаций и вообще в целом я предпочитаю использовать формулы над макросом.

Я пытаюсь описать мое решение ниже.

• входные данные, как показано в вопросе ( B2: F5)
• column_header (C2: F2)
• row_header (B3: B5)
• data_matrix (C3: F5)
• no_of_data_rows (I2) = COUNTA (row_header) + COUNTBLANK (row_header)
• no_of_data_columns (I3) = COUNTA (column_header) + COUNTBLANK (column_header)
• no_output_rows (I4) = no_of_data_rows * no_of_data_columns
• область семян - это K2: M2, которая пуста, но ссылается, следовательно, ее нельзя удалить
• K3 (перетащите, скажем, K100, см. описание комментариев) = ROW () - ROW ( $ K $ 2) & lt; = no_output_rows
• L3 (перетащите, например, L100, см. Описание комментариев) = IF (K3, IF (COUNTIF ($ L $ 2: L2, L2)
• M3 (см. Описание M100, см. Описание комментариев) = IF (K3, IF (M2 & lt; no_of_data_columns, M2 + 1,1), "-")
• N3 (перетащите, скажем, N100, см. Комментарии description) = INDEX (row_header, L3)
[g 12] O3 (перетащите, скажем, O100, см. Описание комментариев) = INDEX (column_header, M3)
• P3 (перетащите, скажем, P100, см. Описание комментариев) = INDEX (data_matrix, L3, M3)
• Комментарий в K3: Необязательно: проверьте, нет ли ожидаемого результата. выходных рядов. Не требуется, если кто-то готовит эту таблицу только к нет. выходных строк.
• Комментарий в L3: Цель: каждый RowIndex (1 .. no_of_data_rows) должен повторять no_of_data_columns раз. Это обеспечит поиск индекса для значений row_header. В этом примере каждый RowIndex (1 .. 3) должен повторять 4 раза. Алгоритм: проверьте, сколько раз RowIndex произошло. Если это меньше, чем no_of_data_columns раз, продолжайте использовать этот RowIndex, иначе увеличьте RowIndex. Необязательно: проверьте, нет ли ожидаемого результата. достигнутых строк.
• Комментарий в M3: Цель: каждый столбец ColumnIndex (1 .. no_of_data_columns) должен повторяться в цикле. Это обеспечит поиск индекса для значений column_header. В этом примере каждый ColumnIndex (1 .. 4) должен повторяться в цикле. Алгоритм: если ColumnIndex превышает no_of_data_columns, перезапустите цикл в 1, иначе увеличьте значение ColumnIndex. Необязательно: проверьте, нет ли ожидаемого результата.
• Комментарий в R4: Необязательно: используйте столбец K для обработки ошибок, как показано в столбце L и столбце M. Проверьте, не исказилось ли значение IsBlank, чтобы избежать неправильного «0» в вывод из-за пустого ввода в data_matrix.

Я разработал еще один макрос, потому что мне нужно было часто обновлять таблицу вывода (входная таблица была заполнена другой), и я хотел получить больше информации в моей выходной таблице (более скопированный столбец и некоторые формулы)

Sub TableConvert()

Dim tbl As ListObject 
Dim t
Rows As Long
Dim tCols As Long
Dim userCalculateSetting As XlCalculation
Dim wrksht_in As Worksheet
Dim wrksht_out As Worksheet

'##block calculate and screen refresh
Application.ScreenUpdating = False
userCalculateSetting = Application.Calculation
Application.Calculation = xlCalculationManual

'## get the input and output worksheet
Set wrksht_in = ActiveWorkbook.Worksheets("ressource_entry")'## input
Set wrksht_out = ActiveWorkbook.Worksheets("data")'## output.


'## get the table object from the worksheet
Set tbl = wrksht_in.ListObjects("Table14")  '## input
Set tb2 = wrksht_out.ListObjects("Table2") '## output.

'## delete output table data
If Not tb2.DataBodyRange Is Nothing Then
    tb2.DataBodyRange.Delete
End If

'## count the row and col of input table

With tbl.DataBodyRange
     tRows = .Rows.Count
     tCols = .Columns.Count
End With

'## check every case of the input table (only the data part)
For j = 2 To tRows '## parse all row from row 2 (header are not checked)
    For i = 5 To tCols '## parse all column from col 5 (first col will be copied in each record)
        If IsEmpty(tbl.Range.Cells(j, i).Value) = False Then
            '## if there is time enetered create a new row in table2 by using the first colmn of the selected cell row and cell header plus some formula
            Set oNewRow = tb2.ListRows.Add(AlwaysInsert:=True)
            oNewRow.Range.Cells(1, 1).Value = tbl.Range.Cells(j, 1).Value
            oNewRow.Range.Cells(1, 2).Value = tbl.Range.Cells(j, 2).Value
            oNewRow.Range.Cells(1, 3).Value = tbl.Range.Cells(j, 3).Value
            oNewRow.Range.Cells(1, 4).Value = tbl.Range.Cells(1, i).Value
            oNewRow.Range.Cells(1, 5).Value = tbl.Range.Cells(j, i).Value
            oNewRow.Range.Cells(1, 6).Formula = "=WEEKNUM([@Date])"
            oNewRow.Range.Cells(1, 7).Formula = "=YEAR([@Date])"
            oNewRow.Range.Cells(1, 8).Formula = "=MONTH([@Date])"
        End If
   Next i
Next j
ThisWorkbook.RefreshAll

'##unblock calculate and screen refresh
Application.ScreenUpdating = True 
Application.Calculate
Application.Calculation = userCalculateSetting

End Sub

Сглаживание матрицы данных (aka Таблица ) может быть выполнено с помощью одной формулы матрицы 1 и двух стандартных формул.

Формула 1 массива и две стандартные формулы в G3: I3:

=IFERROR(INDEX(A$2:A$4, MATCH(0, IF(COUNTIF(G$2:G2, A$2:A$4&"")<COUNT($1:$1), 0, 1), 0)), "")
=IF(LEN(G3), INDEX($B$1:INDEX($1:$1, MATCH(1E+99,$1:$1 )), , COUNTIF(G$3:G3, G3)), "")
=INDEX(A:J,MATCH(G3,A:A,0),MATCH(H3,$1:$1,0))

Заполнять по мере необходимости.

Хотя формулы массива могут отрицательно влиять на производительность из-за их циклического вычисления, описанная рабочая среда из 40 строк × 50 столбцов не должна чрезмерно влиять на производительность с задержкой вычисления.

¹ Формулы массива должны быть завершены с помощью Ctrl + Shift + Enter↵. После правильного ввода в первую ячейку они могут быть заполнены или скопированы или правы точно так же, как и любая другая формула. Попытайтесь уменьшить ссылки на полные столбцы на диапазоны, более подробно представляющие экстенты ваших фактических данных. Формулы массива ломают логарифмически расчетные циклы, поэтому рекомендуется сократить суженные диапазоны ссылок до минимума. Подробнее см. В руководствах и примерах формул массива .

Ответ администратора Адама Дэвиса прекрасен, но на всякий случай вы так же невежественны, как я о Excel VBA, вот что я сделал, чтобы получить код, работающий в Excel 2007:

1. Открыть рабочую книгу с матрицей, которая должна быть сплющена к таблице и перейти к этому листу
2. Нажмите Alt-F11, чтобы открыть редактор кода VBA.
3. На левой панели в Project box, вы увидите древовидную структуру, представляющую объекты excel и любой код (называемые модулями), которые уже существуют. Щелкните правой кнопкой мыши в любом месте окна и выберите «Вставить-> Модуль», чтобы создать пустой файл модуля.
4. Скопируйте и вставьте код @Adman Davis сверху, как на пустой странице, откроется и сохраните его.
5. Закройте окно редактора VBA и вернитесь к электронной таблице.
6. Нажмите на любую ячейку в матрице, чтобы указать матрицу, с которой вы будете работать.
7. Теперь вам нужно запустить макрос. Если этот параметр будет зависеть от вашей версии Excel. Поскольку я использую 2007, я могу сказать вам, что он сохраняет свои макросы в ленте «Просмотр» как самый правый правый элемент управления. Щелкните по нему, и вы увидите список макросов для стирки, просто дважды щелкните по названию «ReversePivotTable», чтобы запустить его.
8. Затем появится всплывающее окно с просьбой указать, где можно создать сплющенный Таблица. Просто укажите его на любое пустое пространство вашей электронной таблицы и нажмите «ok»

. Все готово! Первый столбец будет строками, второй столбец будет столбцом, третьим столбцом будут данные.

Для тех, кто хочет использовать сводную таблицу, чтобы выполнить это, и следуя приведенному ниже руководству: http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

Если вы хотите сделать это в Excel 2007 или 2010, вам сначала нужно включить мастер сводной таблицы.

Чтобы найти этот параметр, вам нужно перейти в «Параметры Excel» с помощью значка главного окна Excel и см. параметры, выбранные в разделе «Настройка», затем выберите «Команды не в ленте» в раскрывающемся меню «Выбрать команды из:», а «Сводная таблица и Мастер PivotChart» необходимо добавить вправо. см. изображение ниже.

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

[/g1]

обновлена ​​функция ReversePivotTable, поэтому я могу указать количество столбцов и строк заголовка

Sub ReversePivotTable()
'   Before running this, make sure you have a summary table with column headers.
'   The output table will have three columns.
    Dim SummaryTable As Range, OutputRange As Range
    Dim OutRow As Long
    Dim r As Long, c As Long

    Dim lngHeaderColumns As Long, lngHeaderRows As Long, lngHeaderLoop As Long

    On Error Resume Next
    Set SummaryTable = ActiveCell.CurrentRegion
    If SummaryTable.Count = 1 Or SummaryTable.Rows.Count < 3 Then
        MsgBox "Select a cell within the summary table.", vbCritical
        Exit Sub
    End If
    SummaryTable.Select

    Set OutputRange = Application.InputBox(prompt:="Select a cell for the 3-column output", Type:=8)
    lngHeaderColumns = Application.InputBox(prompt:="Header Columns")
    lngHeaderRows = Application.InputBox(prompt:="Header Rows")
'   Convert the range
    OutRow = 2
    Application.ScreenUpdating = False
    'OutputRange.Range("A1:D3") = Array("Column1", "Column2", "Column3", "Column4")
    For r = lngHeaderRows + 1 To SummaryTable.Rows.Count
        For c = lngHeaderColumns + 1 To SummaryTable.Columns.Count
            ' loop through all header columns and add to output
            For lngHeaderLoop = 1 To lngHeaderColumns
                OutputRange.Cells(OutRow, lngHeaderLoop) = SummaryTable.Cells(r, lngHeaderLoop)
            Next lngHeaderLoop
            ' loop through all header rows and add to output
            For lngHeaderLoop = 1 To lngHeaderRows
                OutputRange.Cells(OutRow, lngHeaderColumns + lngHeaderLoop) = SummaryTable.Cells(lngHeaderLoop, c)
            Next lngHeaderLoop

            OutputRange.Cells(OutRow, lngHeaderColumns + lngHeaderRows + 1) = SummaryTable.Cells(r, c)
            OutputRange.Cells(OutRow, lngHeaderColumns + lngHeaderRows + 1).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutRow = OutRow + 1
        Next c
    Next r
End Sub

В Excel 2013 необходимо выполнить следующие шаги:

• выбрать данные и преобразовать в таблицу ( Вставка -> Таблица )
• вызов Запрос Редактор таблицы (Power Query -> From Table)
• выберите столбцы, содержащие годы
• в контекстном меню, выберите « Unpivot Columns » - команда.

Служба поддержки: столбцы Unpivot (Power Query)