Как «сплющить» или «свернуть» 2D таблицу Excel в 1D? - PullRequest
39 голосов
/ 26 марта 2009

У меня есть двумерная таблица со странами и годами в Excel. например.

        1961        1962        1963        1964
USA      a           x            g           y
France   u           e            h           a
Germany  o           x            n           p

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

Country      Year       Value
USA          1961       a
USA          1962       x
USA          1963       g
USA          1964       y
France       1961       u
              ...

Пример, который я привожу здесь, представляет собой только матрицу 3х4, но реальный набор данных, который у меня есть, значительно больше (примерно 50х40 или около того).

Любые предложения, как я могу сделать это с помощью Excel?

Ответы [ 9 ]

35 голосов
/ 26 марта 2009

Вы можете использовать функцию сводной таблицы Excel для обращения к сводной таблице (что, по сути, и есть):

Хорошие инструкции здесь:

http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

Который ссылается на следующий код VBA (поместите его в модуль), если вы не хотите следовать инструкциям от руки:

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

    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)
'   Convert the range
    OutRow = 2
    Application.ScreenUpdating = False
    OutputRange.Range("A1:C3") = Array("Column1", "Column2", "Column3")
    For r = 2 To SummaryTable.Rows.Count
        For c = 2 To SummaryTable.Columns.Count
            OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
            OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
            OutputRange.Cells(OutRow, 3) = SummaryTable.Cells(r, c)
            OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutRow = OutRow + 1
        Next c
    Next r
End Sub

-Adam

17 голосов
/ 22 октября 2009

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

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

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

9 голосов
/ 15 августа 2015

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

  • выбрать данные и преобразовать в таблицу ( Вставить -> Таблица )
  • вызов редактора запросов для таблицы ( Power Query -> из таблицы )
  • выберите столбцы, содержащие годы
  • в контекстном меню выберите команду ' Отключить столбцы ' - команда.

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

5 голосов
/ 07 октября 2015

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

1005 *Flatten table into columns

Формула массива¹ и две стандартные формулы в 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↵ . После правильного ввода в первую ячейку, они могут быть заполнены или скопированы вниз или вправо, как и любая другая формула. Попробуйте уменьшить количество ссылок на полные столбцы до диапазонов, более точно представляющих экстенты ваших фактических данных. Формулы массива вычисляют циклы вычислений логарифмически, поэтому рекомендуется сузить указанные диапазоны до минимума. См. Рекомендации и примеры формул массива для получения дополнительной информации.

2 голосов
/ 16 февраля 2013

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

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

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

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

enter image description here

0 голосов
/ 01 октября 2018

Код с претензией на некоторую универсальность Книга должна иметь два листа: Кислый = Исходные данные Dest = "расширенная" таблица опустится сюда

    Option Explicit
    Private ws_Sour As Worksheet, ws_Dest As Worksheet
    Private arr_2d_Sour() As Variant, arr_2d_Dest() As Variant
    ' https://stackoverflow.com/questions/52594461/find-next-available-value-in-excel-cell-based-on-criteria
    Public Sub PullOut(Optional ByVal msg As Variant)
        ws_Dest_Acr _
                arr_2d_ws( _
                arr_2d_Dest_Fill( _
                arr_2d_Sour_Load( _
                arr_2d_Dest_Create( _
                CountA_rng( _
                rng_2d_For_CountA( _
                Init))))))
    End Sub

    Private Function ws_Dest_Acr(Optional ByVal msg As Variant) As Variant
        ws_Dest.Activate
    End Function

    Public Function arr_2d_ws(Optional ByVal msg As Variant) As Variant
        If IsArray(arr_2d_Dest) Then _
           ws_Dest.Cells(1, 1).Resize(UBound(arr_2d_Dest), UBound(arr_2d_Dest, 2)) = arr_2d_Dest
    End Function

    Private Function arr_2d_Dest_Fill(Optional ByVal msg As Variant) As Variant
        Dim y_Sour As Long, y_Dest As Long, x As Long
        y_Dest = 1
        For y_Sour = LBound(arr_2d_Sour) To UBound(arr_2d_Sour)
            ' without the first column
            For x = LBound(arr_2d_Sour, 2) + 1 To UBound(arr_2d_Sour, 2)
                If arr_2d_Sour(y_Sour, x) <> Empty Then
                    arr_2d_Dest(y_Dest, 1) = arr_2d_Sour(y_Sour, 1)    'iD
                    arr_2d_Dest(y_Dest, 2) = arr_2d_Sour(y_Sour, x)    'DTLx
                    y_Dest = y_Dest + 1
                End If
            Next
        Next
    End Function

    Private Function arr_2d_Sour_Load(Optional ByVal msg As Variant) As Variant
        arr_2d_Sour = ReDuce_rng(ws_Sour.UsedRange, 1, 0).Offset(1, 0).Value
    End Function

    Private Function arr_2d_Dest_Create(ByVal iRows As Long)
        Dim arr_2d() As Variant
        ReDim arr_2d(1 To iRows, 1 To 2)
        arr_2d_Dest = arr_2d
        arr_2d_Dest_Create = arr_2d
    End Function

    Public Function CountA_rng(ByVal rng As Range) As Double
        CountA_rng = Application.WorksheetFunction.CountA(rng)
    End Function

    Private Function rng_2d_For_CountA(Optional ByVal msg As Variant) As Range
        ' without the first line and without the left column
        Set rng_2d_For_CountA = _
        ReDuce_rng(ws_Sour.UsedRange, 1, 1).Offset(1, 1)
    End Function

    Public Function ReDuce_rng(rng As Range, ByVal iRow As Long, ByVal iCol As Long) _
           As Range
        With rng
            Set ReDuce_rng = .Resize(.Rows.Count - iRow, .Columns.Count - iCol)
        End With
    End Function

    Private Function Init()
        With ThisWorkbook
            Set ws_Sour = .Worksheets("Sour")
            Set ws_Dest = .Worksheets("Dest")
        End With
    End Function

'https://youtu.be/oTp4aSWPKO0
0 голосов
/ 06 декабря 2017

обновлена ​​функция 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
0 голосов
/ 16 августа 2017

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

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
0 голосов
/ 29 августа 2012

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

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

  • входные данные, как показано в вопросе (B2: F5)
  • заголовок столбца (C2: F2)
  • заголовок строки (B3: B5)
  • data_matrix (C3: F5)
  • no_of_data_rows (I2) = COUNTA (заголовок строки) + COUNTBLANK (заголовок строки)
  • no_of_data_columns (I3) = COUNTA (заголовок столбца) + COUNTBLANK (заголовок столбца)
  • no_output_rows (I4) = no_of_data_rows * no_of_data_columns
  • начальная область - K2: M2, которая является пустой, но на нее ссылаются, следовательно, не должна быть удалена
  • K3 (перетащите, скажем, через K100, см. Описание комментариев) = ROW () - ROW ($ K $ 2) <= no_output_rows </li>
  • L3 (перетащите, скажем, L100, см. Описание комментариев) = IF (K3, IF (COUNTIF ($ L $ 2: L2, L2))
  • M3 (перетащите, скажем, через M100, см. Описание комментариев) = IF (K3, IF (M2
  • N3 (перетащите, скажем, через N100, см. Описание комментариев) = INDEX (row_header, L3)
  • 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.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...