2D Excelテーブルを1Dに「フラット化」または「コラプス」する方法

Question

Excelの国と年の2次元のテーブルがあります。例えば。

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

最初の列にCountry、2番目の列にYear、3番目の列にvalueがあるように、「フラット化」したいと思います。例えば。

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

-アダム

Answer 2

@Adam Davisの答えは完璧ですが、Excel VBAのようにあなたが無知である場合に備えて、Excel 2007でコードを機能させるために行ったことは次のとおりです。

1. テーブルにフラット化する必要があるマトリックスを使用してワークブックを開き、そのワークシートに移動します
2. Alt-F11を押してVBAコードエディターを開きます。
3. 左側のペインの[プロジェクト]ボックスに、Excelオブジェクトと既存のコード（モジュールと呼ばれる）を表すツリー構造が表示されます。ボックス内の任意の場所を右クリックし、[挿入]> [モジュール]を選択して、空のモジュールファイルを作成します。
4. 上記の@Adman Davisのコードをそのままコピーして、開いた空白のページに貼り付けて保存します。
5. VBAエディターウィンドウを閉じて、スプレッドシートに戻ります。
6. マトリックス内の任意のセルをクリックして、使用するマトリックスを示します。
7. 次に、マクロを実行する必要があります。このオプションの場所は、Excelのバージョンによって異なります。 2007を使用しているため、マクロを「表示」リボンに最も右のコントロールとして保持していることがわかります。クリックすると、マクロのランドリーリストが表示されます。「ReversePivotTable」という名前のマクロをダブルクリックして実行します。
8. 次に、フラット化されたテーブルを作成する場所を指定するように求めるポップアップが表示されます。スプレッドシートの空のスペースをポイントして、[OK]をクリックするだけです

完了です！最初の列は行、2番目の列は列、3番目の列はデータになります。

Answer 3

Excel 2013では、次の手順に従う必要があります。

• データを選択してテーブルに変換（Insert-> Table）
• テーブルのクエリエディターを呼び出す（Power Query-> From Table）
• 年を含む列を選択する
• コンテキストメニューで「Unpivot Columns」コマンドを選択します。

サポートオフィス：列のピボット解除（パワークエリ）

Answer 4

データ行列のフラット化（別名Table）は、1つの配列式¹と2つの標準式で実現できます。

G3：I3の配列式¹と2つの標準式は、

=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↵。最初のセルに正しく入力すると、他の数式と同じように、それらを塗りつぶしたりコピーしたりできます。実際のデータの範囲をより厳密に表す範囲に全列参照を減らしてみてください。配列の数式は計算サイクルを対数的に噛むため、参照される範囲を最小限に抑えることをお勧めします。詳細については、 配列式のガイドラインと例 を参照してください。}

Answer 5

これを行うためにピボットテーブルを使用したい人のために、以下のガイドに従っています： http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

Excel 2007または2010で実行する場合は、最初にピボットテーブルウィザードを有効にする必要があります。

オプションを見つけるには、メインExcelウィンドウアイコンから[Excelオプション]に移動し、[カスタマイズ]セクションで選択したオプションを確認し、[コマンドの選択元：]ドロップダウンから[リボンにないコマンド]を選択します。 「ピボットテーブルとピボットグラフウィザード」を右側に追加する必要があります。下の画像を参照してください。

これが完了すると、Excelウィンドウの上部にあるクイックバーメニューに小さなピボットウィザードアイコンが表示され、上記のリンクに示されているのと同じプロセスを実行できます。

Answer 6

普遍性を主張するコード本には2枚のシートが必要です。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

Answer 7

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）<= no_output_rows
• L3（たとえば、L100をドラッグしてコメントの説明を参照）= IF（K3、IF（COUNTIF（$ L $ 2：L2、L2）
• M3（M100をドラッグしてコメントの説明を参照）= IF（K3、IF（M2 <no_of_data_columns、M2 + 1,1）、 "-"）
• 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をインクリメントします。 オプション：noが期待されるかどうかを確認します。出力行の達成されました。
• M3のコメント：目標：各ColumnIndex（1 .. no_of_data_columns）はサイクルで繰り返す必要があります。これにより、column_header値のインデックスルックアップが提供されます。この例では、各ColumnIndex（1 .. 4）はサイクルで繰り返す必要があります。 アルゴリズム：ColumnIndexがno_of_data_columnsを超える場合、サイクルを1から再開します。それ以外の場合、ColumnIndexを増分します。 オプション：noが期待されるかどうかを確認します。出力行の達成されました。
• R4のコメント：オプション：列Kと列Mに示すように、エラー処理に列Kを使用します。ルックアップされた値IsBlankをチェックして、data_matrixの空白入力による出力の不正な「0」を回避します。

Answer 8

出力テーブルを頻繁に更新する必要があるため（入力テーブルは他の人によっていっぱいになった）、出力テーブル（コピーされた列といくつかの数式）により多くの情報が必要だったため、別のマクロを開発しました

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

Answer 9

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