vba - 如何将 "flatten"或 "collapse"2D Excel 表转换为 1D？

Question

我在 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
              ...

我在这里展示的示例只是一个 3x4 矩阵，但我拥有的真实数据集要大得多(大约 50x40 左右)。

有什么建议可以让我使用 Excel 来完成此操作吗？

Answer 1

您可以使用 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

-亚当