Comment "aplatir" ou "réduire" une table Excel 2D en 1D?

j'ai un tableau en deux dimensions avec les pays et les années dans Excel. par exemple.

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

j'aimerais "l'aplatir", de sorte que J'ai le pays dans la première colonne, L'année dans la deuxième colonne, et puis la valeur dans la troisième colonne. eg.

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

L'exemple que je présente ici n'est qu'une matrice 3x4, mais le vrai dataset j'ai est nettement plus élevé (environ 50x40).

toutes les suggestions Comment puis-je faire cela en utilisant Excel?

36
demandé sur pnuts 2009-03-26 23:34:38

9 réponses

vous pouvez utiliser la fonction excel pivot table pour inverser une table pivotante (qui est essentiellement ce que vous avez ici):

bonnes instructions ici:

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

qui renvoie au code VBA suivant (mettez-le dans un module) si vous ne voulez pas suivre les instructions à la main:

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

35
répondu Adam Davis 2009-03-26 20:38:35

la réponse de @Adam Davis est parfaite, mais juste au cas où vous êtes aussi ignorant que je suis sur Excel VBA, voici ce que j'ai fait pour obtenir le code de travail dans Excel 2007:

  1. ouvrir le classeur avec la matrice qui doit être aplatie à une table et naviguer à cette feuille de travail
  2. appuyez sur Alt-F11 pour ouvrir l'éditeur de code VBA.
  3. sur le volet de gauche, dans la case de projet, vous verrez une structure d'arbre représentant l'excel les objets et tout code (appelé modules) qui existent déjà. Cliquez avec le bouton droit de la souris n'importe où dans la case et sélectionnez "Insérer->Module" pour créer un fichier de module vierge.
  4. copiez et collez le code d'en haut de @Adman Davis tel qu'il se trouve sur la page vierge, ouvrez et sauvegardez-le.
  5. fermez la fenêtre de l'éditeur VBA et retournez au tableur.
  6. cliquez sur n'importe quelle cellule de la matrice pour indiquer la matrice avec laquelle vous travaillerez.
  7. Maintenant vous besoin pour exécuter la macro. Où cette option est varie en fonction de votre version D'Excel. Comme j'utilise 2007, je peux vous dire qu'il garde ses macros dans le ruban de "vue" comme le contrôle le plus à droite. Cliquez dessus et vous verrez une liste de macros, il suffit de double cliquer sur celle appelée "ReversePivotTable" pour l'exécuter.
  8. il affichera alors un popup vous demandant de lui dire où créer la table aplatie. Il suffit de pointer vers n'importe quel espace vide Un votre tableur et cliquez sur " ok"

C'est fini! La première colonne sera les lignes, la deuxième sera les colonnes, la troisième sera les données.

17
répondu Michael La Voie 2009-10-21 20:26:12

dans Excel 2013 doivent suivre les prochaines étapes:

  • sélectionner les données et les convertir en tableau ( insérer -> tableau )
  • appel de l'Éditeur de Requête pour la table ( Power Query -> à Partir de la Table )
  • sélectionnez les colonnes qui contiennent les années
  • dans le menu contextuel, sélectionnez ' Unpivot Colonnes '-commande.

Bureau d'Appui: Unpivot colonnes (Power Query)

6
répondu vladimir77 2015-08-14 22:19:01

aplatir une matrice de données (alias Table ) peut être accompli avec un tableau formula1 et deux formules standard.

Flatten table into columns

Le tableau de formule1 et deux formules standard dans le G3:I3 sont est,

=IFERROR(INDEX(A:A, MATCH(0, IF(COUNTIF(G:G2, A:A&"")<COUNT(:), 0, 1), 0)), "")
=IF(LEN(G3), INDEX($B:INDEX(:, MATCH(1E+99,: )), , COUNTIF(G:G3, G3)), "")
=INDEX(A:J,MATCH(G3,A:A,0),MATCH(H3,:,0))

remplir si nécessaire.

alors que les formules de tableaux peuvent avoir un impact négatif sur les performances en raison de leur caractère cyclique calcul, votre environnement de travail décrit de 40 lignes × 50 colonnes ne devrait pas trop affecter la performance avec un retard de calcul.


1 les formules de tableaux doivent être finalisées avec Ctrl + Shift + Enter փ . Une fois entrés correctement dans la première cellule, ils peuvent être remplis ou copiés vers le bas ou droit comme n'importe quelle autre formule. Essayez de réduire la colonne entière des références à des fourchettes représentant plus étroitement l'étendue de vos données réelles. Les formules de tableaux modifient les cycles de calcul de façon logarithmique, de sorte qu'il est recommandé de réduire au minimum les intervalles de référence. Voir lignes directrices et exemples de formules de tableaux pour plus d'information.

5
répondu Jeeped 2015-10-07 02:59:58

pour toute personne qui veut utiliser le pivot pour le faire et suit le guide ci-dessous: http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/

si vous voulez le faire dans Excel 2007 ou 2010, alors vous devez d'abord activer L'Assistant pivotable.

pour trouver l'option vous devez aller à "Options Excel" via L'icône de la fenêtre principale Excel, et voir les options sélectionnées dans le section "Personnaliser", puis sélectionner "commandes ne figurant pas dans le ruban" dans la section "Choisir les commandes:" dropdown et "pivot et pivot Wizard" doit être ajouté à droite.. voir l'image ci-dessous.

une fois que cela est fait, il devrait y avoir une petite icône d'Assistant pivotable dans le menu quickbar en haut de la fenêtre Excel, vous pouvez alors suivre le même processus que montré dans le lien ci-dessus.

enter image description here

2
répondu Pricey 2013-02-16 13:53:53

VBA solution peut ne pas être acceptable dans certaines situations (par exemple, ne peut pas incorporer macro pour des raisons de sécurité, etc.). Pour ces situations, et autrement aussi en général, je préfère utiliser des formules plutôt que des macros.

j'essaie de décrire ma solution ci-dessous.

  • données d'entrée comme indiqué dans la question (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
  • la surface de semence est K2: M2, blanc mais référencé, donc à ne pas supprimer
  • K3 (faites-le glisser à travers dire K100, voir les commentaires description) = LIGNE()-LIGNE($K$2) <= no_output_rows
  • L3 (faites glisser say L100, voir description des commentaires) = IF (K3, IF (COUNTIF ($L$2: L2,L2)
  • M3 (faites glisser say M100, voir la description des commentaires) = si(K3, si (M2 < no_of_data_columns, M2+1,1),"-")
  • N3 (faites-le glisser à travers dire N100, voir les commentaires description) = INDEX(row_header,L3)
  • O3 (faites-le glisser à travers dire O100, voir les commentaires description) = INDEX(column_header,M3)
  • P3 (drag par say P100, voir description des commentaires) = INDEX (data_matrix,L3,M3)
  • Commentaire dans K3: Facultatif : Vérifier si attend pas. des lignes de sortie ont été atteintes. Pas nécessaire, si l'on ne prépare ce tableau limité à pas. de lignes de sortie.
  • Commentaire en L3: Objectif : Chaque RowIndex (1 .. no_of_data_rows) doit répéter no_of_data_columns fois. Ceci fournira la recherche d'index pour les valeurs de row_header. Dans ce exemple, chaque RowIndex (1 .. 3) doit répéter 4 fois. algorithme : vérifiez combien de fois RowIndex s'est déjà produit. S'il est inférieur à no_of_data_columns times, continuez à utiliser ce RowIndex, sinon incrémentez le RowIndex. facultatif : vérifier si prévu no. des lignes de sortie ont été atteintes.
  • Commentaire en M3: Objectif : Chaque ColumnIndex (1 .. no_of_data_columns) doit être répété dans un cycle. Cela donnera recherche dans l'index des valeurs column_header. Dans cet exemple, chaque colonne (1 .. 4) doit être répété dans un cycle. algorithme : si ColumnIndex dépasse no_of_data_columns, redémarrez le cycle à 1, sinon incrémentez la ColumnIndex. facultatif : vérifier si prévu no. des lignes de sortie ont été atteintes.
  • commentaire dans R4: facultatif : utiliser la colonne K pour le traitement des erreurs, comme indiqué dans les colonnes L et M. vérifier si la valeur cherchée est bloquée pour éviter un "0" incorrect dans la sortie à cause d'une entrée vide dans data_matrix.
0
répondu Vishal Haria 2012-08-29 08:00:32

j'ai développé une autre macro parce que j'avais besoin de rafraîchir la table de sortie assez souvent (la table d'entrée a été remplie par autre) et je voulais avoir plus d'information dans ma table de sortie (plus de colonne copiée et quelques formules)

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
répondu Delcroip 2017-08-16 10:21:29

fonction Réversepivottable mise à jour pour que je puisse spécifier le nombre de colonnes d'en-tête et de lignes

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
répondu user9063393 2017-12-06 18:02:58

Code avec la revendication d'une certaine universalité Le livre doit avoir deux feuilles: Sour = données de base Dest = la table " étendue "va tomber ici

    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
répondu Михаил Попов 2018-10-01 19:21:36