Jak "spłaszczyć" lub "zwinąć" tabelę Excel 2D na 1D?

@ Adam Davis odpowiedź jest idealna, ale na wypadek gdybyś był tak samo głupi jak ja o Excelu VBA, oto co zrobiłem, aby Kod działał w Excelu 2007:

1. otwórz skoroszyt z matrycą, która musi zostać spłaszczona do tabeli i przejdź do tego arkusza
2. naciśnij Alt-F11, aby otworzyć edytor kodu VBA.
3. w lewym okienku, w oknie projektu, zobaczysz strukturę drzewa reprezentującą obiekty programu excel i dowolny kod (zwane modułami), które już istnieją. Prawo kliknij w dowolnym miejscu w polu i wybierz "Wstaw - > moduł", aby utworzyć pusty plik modułu.
4. Skopiuj i wklej kod @ Adman Davis z góry jak jest na pustej stronie otwiera i zapisać go.
5. Zamknij okno edytora VBA i wróć do arkusza kalkulacyjnego.
6. Kliknij dowolną komórkę w matrycy, aby wskazać matrycę, z którą będziesz pracować.
7. Teraz musisz uruchomić makro. Gdzie jest ta opcja będzie się różnić w zależności od wersji programu Excel. Ponieważ używam 2007, mogę powiedzieć, że to zachowuje swoje makra na wstążce "Widok" jako najdalszą prawą kontrolę. Kliknij go, a zobaczysz listę makr prania, po prostu kliknij dwukrotnie na jeden o nazwie "ReversePivotTable", aby go uruchomić.
8. wyświetli się okienko z prośbą o wskazanie miejsca utworzenia spłaszczonej tabeli. Po prostu skieruj go do dowolnego pustego miejsca w arkuszu kalkulacyjnym i kliknij " ok "

Jesteś skończony! Pierwsza kolumna to wiersze, Druga kolumna to kolumny, Trzecia kolumna to dane.

W Excelu 2013 należy wykonać następujące kroki:

• Wybierz Dane i przekonwertuj na tabelę (Insert - > Table)
• wywołanie Edytora zapytań dla table (Power Query -> From Table)
• Wybierz kolumny zawierające lata
• w menu kontekstowym wybierz 'kolumny Unpivot'-dowództwo.

Support Office: unpivot columns (Power Query)

Spłaszczenie macierzy danych (aka Tabela ) można wykonać za pomocą jednej tablicy formula_1 i dwóch standardowych formuł.

Tablica formula1 i dwa standardowe wzory w G3: I3 są to

=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))

Wypełnić w razie potrzeby.

Podczas gdy formuły tablicowe mogą negatywnie wpływać na wydajność ze względu na ich cykliczne obliczenia, opisane środowisko pracy 40 wierszy × 50 kolumn nie powinno zbytnio wpływać na wydajność obliczeń / align = "left" /

1 _{Formuły tablicowe należy zakończyć za pomocą Ctrl+Shift+wpisz↵. Po prawidłowym wprowadzeniu do pierwszej komórki można je wypełnić lub skopiować w dół lub w prawo, podobnie jak każda inna formuła. Spróbuj zredukować odniesienia do pełnych kolumn do zakresów, które pełniej reprezentują zakres rzeczywistych danych. Formuły tablicowe zwiększają cykle obliczeniowe logarytmicznie, dlatego warto zawęzić zakresy odniesienia do minimum. Zob. Wytyczne i przykłady formuł tablicowych aby uzyskać więcej informacji.}

Dla każdego, kto chce skorzystać z tabeli przestawnej i postępuje zgodnie z poniższym przewodnikiem: http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

Jeśli chcesz to zrobić w Excelu 2007 lub 2010, najpierw musisz włączyć Kreatora tabeli przestawnej.

Aby znaleźć opcję, przejdź do "Opcje programu Excel" za pomocą ikony głównego okna programu Excel i zobacz opcje wybrane w sekcji "Dostosuj", a następnie wybierz " polecenia nie na Wstążce" z listy rozwijanej" wybierz polecenia z: "i" PivotTable and PivotChart Wizard " należy dodać po prawej stronie.. zobacz obrazek poniżej.

Po zakończeniu tego procesu powinna być mała ikona kreatora tabeli przestawnej w menu szybkiego paska u góry okna programu Excel, możesz następnie wykonać ten sam proces, jak pokazano w linku powyżej.

Rozwiązanie VBA może nie być akceptowalne w niektórych sytuacjach (np. nie można osadzać makra ze względów bezpieczeństwa itp.). W takich sytuacjach, a poza tym ogólnie wolę używać formuł niż makro.

Staram się opisać moje rozwiązanie poniżej.

• Dane wejściowe przedstawione w pytaniu (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
• Powierzchnia nasion to K2: M2, która jest pusta, ale odwołuje się, stąd nie należy jej usuwać
• K3 (przeciągnij przez K100, patrz opis komentarzy) = ROW()-ROW($K$2)
• L3 (przeciągnij przez say L100, patrz opis komentarzy) = IF (K3, IF (COUNTIF ($L$2: L2,L2)
• M3 (przeciągnij przez M100, zobacz opis komentarza) = IF (K3, IF (m2
• N3 ( przeciągnij przez N100, patrz opis komentarzy) = INDEX (row_header, L3)
• O3 ( przeciągnij przez powiedz O100, zobacz opis komentarzy) = INDEX (column_header, M3)
• P3 ( przeciągnij przez powiedzmy P100, patrz opis komentarzy) = INDEX (data_matrix, L3, M3)
• komentarz w kodzie K3: Opcjonalnie : sprawdź czy nie. z wierszy wyjściowych został osiągnięty. Nie jest wymagane, jeśli tylko przygotowuje Ten stół ograniczony do no. wierszy wyjściowych.
• komentarz w L3: Gol : Each RowIndex (1 .. no_of_data_rows) musi powtarzać razy no_of_data_columns. Spowoduje to wyszukiwanie indeksów dla wartości row_header. W tym przykładzie każdy RowIndex (1 .. 3) należy powtórzyć 4 razy. algorytm : Sprawdź, ile razy RowIndex wystąpił jeszcze. Jeśli jest mniejsza niż no_of_data_columns razy, kontynuuj używanie tego RowIndex, w przeciwnym razie zwiększ RowIndex. opcjonalne : sprawdź, czy nie. z wierszy wyjściowych zostało / align = "left" /
• komentarz w M3: cel : każda kolumna (1 .. no_of_data_columns) musi powtarzać się w cyklu. Spowoduje to wyszukiwanie indeksów wartości column_header. W tym przykładzie każdy ColumnIndex (1 .. 4) musi powtarzać w cyklu. algorytm : Jeśli ColumnIndex przekroczy no_of_data_columns, uruchom ponownie cykl o 1, w przeciwnym razie zwiększ ColumnIndex. opcjonalne : sprawdź, czy nie. z wierszy wyjściowych został osiągnięty.
• komentarz w R4: Opcjonalnie : użyj kolumna K służy do obsługi błędów, jak pokazano w kolumnie L i kolumnie M. sprawdź, czy szukana wartość IsBlank, aby uniknąć błędnego "0" na wyjściu z powodu pustego wejścia w data_matrix.

Opracowałem inne makro, ponieważ musiałem dość często odświeżać tabelę wyjściową (tabela wejściowa była wypełniana przez inne) i chciałem mieć więcej informacji w mojej tabeli wyjściowej (więcej skopiowanych kolumn i niektórych formuł)

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

Zaktualizowano funkcję ReversePivotTable, dzięki czemu mogę określić liczbę kolumn i wierszy nagłówka

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

Kod z twierdzeniem o jakiejś uniwersalności Książka powinna mieć dwa arkusze: Sour = dane źródłowe Dest = "Rozszerzona" tabela spadnie tutaj

    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