Comment "aplatir" ou "réduire" un tableau 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
Je voudrais "l'aplatir", de telle sorte que j'ai Pays dans le premier col, Année dans le deuxième col, puis valeur dans le troisième col. par exemple.
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 jeu de données réel que j'ai est beaucoup plus volumineux (environ 50x40 environ).
Des suggestions comment je peux faire ceci en utilisant Excel?
Vous pouvez utiliser la fonctionnalité de tableau croisé dynamique Excel pour inverser un tableau croisé dynamique (ce qui correspond essentiellement à ce que vous avez ici):
Bonnes instructions ici:
http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/
Quels liens vers le 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
La réponse de @Adam Davis est parfaite, mais juste au cas où vous seriez aussi naïf que moi au sujet d'Excel VBA, voici ce que j'ai fait pour que le code fonctionne dans Excel 2007:
- Ouvrez le classeur avec la matrice qui doit être aplatie dans un tableau et accédez à cette feuille de calcul.
- Appuyez sur Alt-F11 pour ouvrir l'éditeur de code VBA.
- Dans le volet gauche, dans la zone Projet, vous verrez une arborescence représentant les objets Excel et tout code (appelé modules) déjà existant. Faites un clic droit n'importe où dans la boîte et sélectionnez "Insérer-> Module" pour créer un fichier de module vierge.
- Copiez et collez le code de @Adman Davis ci-dessus tel quel dans la page vierge et ouvrez-le, puis enregistrez-le.
- Fermez la fenêtre de l'éditeur VBA et revenez à la feuille de calcul.
- Cliquez sur n'importe quelle cellule de la matrice pour indiquer la matrice avec laquelle vous allez travailler.
- Maintenant, vous devez exécuter la macro. L'emplacement de cette option varie en fonction de votre version d'Excel. Comme j'utilise 2007, je peux vous dire que ses macros sont conservées dans le ruban "Vue" en tant que contrôle le plus à droite. Cliquez dessus et vous verrez une liste complète de macros, double-cliquez simplement sur celle appelée "ReversePivotTable" pour l'exécuter.
- Il affichera ensuite une fenêtre contextuelle vous demandant de lui dire où créer la table aplatie. Il suffit de le pointer sur un espace vide de votre feuille de calcul et de cliquer sur "ok"
Vous avez terminé! La première colonne sera les lignes, la deuxième colonne sera les colonnes, la troisième colonne sera les données.
Dans Excel 2013, vous devez suivre les étapes suivantes:
- sélectionner des données et convertir en tableau (Insertion -> Tableau)
- appelez l'éditeur de requête pour la table (Power Query -> à partir de la table)
- sélectionner des colonnes contenant des années
- dans le menu contextuel, sélectionnez 'Colonnes UnPivot} _' - commande.
Voir tous les fichiers de données (au moins Tablea) Cliquez ici pour afficher les informations sur le produit ou le type de document. Standardformeln durchgeführt werden.
Die Matrixformel¹ und zwei Standardformeln in G3: I3 lauten wie folgt:
=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))
Bei Bedarf ausfüllen.
Cliquez sur le lien ci-dessous pour afficher toutes les précisions sur ce sujet dans les annales.
¹Array-Formeln est terminéCtrl+Shift+Enter↵. Sobald sie korrekt in die erste Zelle eingegeben wurden, können sie wie jede andere Formel ausgefüllt oder nach unen ou unrh kopiert werden. Versusen Sie, die Verweise auf ganze Spalten auf Bereiche zu reduzieren, die den Umfang Ihrer tatsächlichen Daten besser wiedergeben. Array-Formeln kauen die Berechnungszyklen logarithmisch auf, dass es ratsam ist, the referenzierten Bereiche auf ein Minimum zu beschränken. Weitere Informationen finden Sieenter Richtlinien und Beispiele für Array-Formeln .
Pour ceux qui souhaitent utiliser le tableau croisé dynamique à cette fin et qui suivent le guide ci-dessous: http://spreadsheetpage.com/index.php/tip/creating_a_database_table_from_a_summary_table/
Si vous souhaitez le faire dans Excel 2007 ou 2010, vous devez d'abord activer l'Assistant Tableau croisé dynamique.
Pour trouver l'option, vous devez accéder à "Options Excel" via l'icône de la fenêtre principale d'Excel et voir les options sélectionnées dans la section "personnaliser", puis sélectionner "Les commandes ne figurent pas dans le ruban" dans le menu déroulant "Choisir les commandes parmi:". et "Assistant de tableau croisé dynamique et graphique croisé dynamique" doivent être ajoutés à droite .. voir l'image ci-dessous.
Une fois que cela est fait, il devrait y avoir une petite icône d’assistant pivotant dans le menu de la barre rapide en haut de la fenêtre Excel, vous pouvez alors suivre le même processus comme indiqué dans le lien ci-dessus.
Code avec la revendication d'une certaine universalité Le livre devrait avoir deux feuilles: Sour = Données source 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
La solution VBA peut ne pas être acceptable dans certaines situations (par exemple, impossible d'incorporer une 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 (en-tête de colonne) + COUNTBLANK (en-tête de colonne)
- no_output_rows (I4) = no_of_data_rows * no_of_data_columns
- la surface de départ est K2: M2, ce qui est vide mais référencé et ne doit donc pas être supprimé
- K3 (faites glisser par exemple K100, voir la description des commentaires) = ROW () - ROW ($ K $ 2) <= no_output_rows
- L3 (faites glisser jusqu'à L100, voir la description des commentaires) = IF (K3, IF (COUNTIF ($ L $ 2: L2, L2)
- M3 (faites glisser par exemple M100, voir la description des commentaires) = IF (K3, IF (M2 <no_of_data_columns, M2 + 1,1), "-")
- N3 (faites glisser par exemple N100, voir la description des commentaires) = INDEX (row_header, L3)
- O3 (faites glisser jusqu'à dire O100, voir la description des commentaires) = INDEX (column_header, M3)
- P3 (faites glisser jusqu'à P100, voir la description des commentaires) = INDEX (data_matrix, L3, M3)
- Commentaire dans K3: Facultatif : Cochez si non attendu. des lignes de sortie a été atteint. Non requis, si l'on ne prépare que cette table limitée à no. des lignes de sortie.
- Commentaire en L3: But : Chaque RowIndex (1 .. no_of_data_rows) doit répéter no fois of_data_columns. Cela fournira une recherche d'index pour les valeurs de row_header. Dans cet exemple, chaque RowIndex (1 .. 3) doit être répété 4 fois. Algorithme : Vérifiez le nombre de fois que RowIndex s'est déjà produit. Si le nombre d'heures est inférieur à no_of_data_columns, continuez à utiliser RowIndex, sinon incrémentez RowIndex. Facultatif : Vérifie si non attendu. des lignes de sortie a été atteint.
- Commentaire dans M3: But : Chaque ColumnIndex (1 .. no_of_data_columns) doit être répété dans un cycle. Cela fournira une recherche d'index pour les valeurs column_header. Dans cet exemple, chaque ColumnIndex (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 ColumnIndex. Facultatif : Vérifie si non attendu. des lignes de sortie a été atteint.
- Commentaire dans R4: Facultatif : Utilisez la colonne K pour le traitement des erreurs, comme indiqué dans les colonnes L et M. Vérifiez si la valeur recherchée IsBlank évite un "0" incorrect dans la sortie en raison d'une entrée vide dans data_matrix.
J'ai développé une autre macro parce que j'avais souvent besoin d'actualiser la table de sortie (la table d'entrée était remplie par une autre) et je voulais avoir plus d'informations dans ma table de sortie (colonne plus copiée et certaines 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
mise à jour de la fonction ReversePivotTable afin que je puisse spécifier le nombre de colonnes et de lignes d'en-tête
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