Как «сплющить» или «свернуть» 2D таблицу Excel в 1D?

excel vba excel-vba

55233 просмотра

9 ответа

У меня есть двухмерная таблица со странами и годами в 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?

Автор: emmby Источник Размещён: 12.11.2019 09:32

Ответы (9)


36 плюса

Решение

Вы можете использовать функцию сводной таблицы 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 Davis Размещён: 26.03.2009 08:38

17 плюса

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

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

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

Автор: Michael La Voie Размещён: 21.10.2009 08:26

10 плюса

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

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

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

Автор: vladimir Размещён: 14.08.2015 10:19

5 плюса

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

      Свести таблицу в столбцы

Формула массива¹ и две стандартные формулы в 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 столбцов не должна чрезмерно влиять на производительность с задержкой вычислений.


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

Автор: user4039065 Размещён: 07.10.2015 02:59

3 плюса

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

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

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

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

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

Автор: Pricey Размещён: 16.02.2013 01:53

0 плюса

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

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

  • входные данные, как показано в вопросе (B2: F5)
  • header_header (C2: F2)
  • row_header (B3: B5)
  • матрица данных (C3: F5)
  • no_of_data_rows (I2) = COUNTA (заголовок строки) + COUNTBLANK (заголовок строки)
  • 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) <= no_output_rows
  • 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.
Автор: Vishal Haria Размещён: 29.08.2012 06:38

0 плюса

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

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
Автор: Delcroip Размещён: 16.08.2017 10:21

0 плюса

обновлена ​​функция 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
Автор: user9063393 Размещён: 06.12.2017 06:02

0 плюса

Код с претензией на некоторую универсальность Книга должна иметь два листа: Sour = Исходные данные 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
Автор: Михаил Попов Размещён: 01.10.2018 07:21
32x32