Synthétiser automatiquement des cellules non vides
Bonjour,
Je ne sais pas si cela est possible, mais je souhaiterai synthétiser automatiquement des cellules non vides d'un tableau (Feuil1) dans un second onglet (Feuil2).
Le tableau (Feuil1) étant déjà un tableau qui se génère automatiquement, j'ai besoin que la synthèse se mette à jour également automatiquement.
Je vous remercie énormément pour votre aide.
Bonjour,
Ci-après une solution via macro : entrez le code en question dans un module et lancez la macro CreerSynthese
NOTA : je n'ai pas pris le temps de redéfinir les bordures du tableau final (un peu ennuyant en VBA). Si vous le souhaitez, je peux quand même l'ajouter.
Option Explicit
Public Sub CreerSynthese()
Dim baseWs As Worksheet: Set baseWs = ThisWorkbook.Worksheets("Feuil1")
Dim outWs As Worksheet: Set outWs = ThisWorkbook.Worksheets("Feuil2")
Dim headerRng As Range
Set headerRng = Range(baseWs.Range("A5"), baseWs.Range("A5").End(xlToRight))
Dim yearVal As String: yearVal = baseWs.Range("B1").Value
' nettoyage feuille resultats
CleanOutputSheet outWs
Application.ScreenUpdating = False
Dim i As Long, valsProg, rngMontant As Range, valsOut
For i = 2 To headerRng.Count
' recup valeurs
With headerRng
valsProg = Range(.Cells(1).Offset(1), .Cells(1).Offset(1).End(xlDown)).Value2
Set rngMontant = Range(.Cells(i).Offset(1), .Cells(i).Offset(1).End(xlDown))
End With
' tableau synthese
valsOut = GetValsOut(valsProg, rngMontant, headerRng.Cells(i).Value2)
' ecriture feuille synthese
If Not IsEmpty(valsOut) Then
outWs.Cells(outWs.Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(valsOut), 3).Value2 = valsOut
End If
Next i
' mise en page
outWs.Range("A1").Value2 = yearVal
With outWs.Range("A1:C1")
.EntireColumn.AutoFit
.Merge
.HorizontalAlignment = xlHAlignCenter
End With
Application.ScreenUpdating = True
End Sub
Private Function GetValsOut(valsProg As Variant, rngMontant As Range, section As String) As Variant
Dim rowsToKeep As Collection: Set rowsToKeep = New Collection
Dim valsMontant: valsMontant = rngMontant.Value2
Dim i As Long
' loop on valsProg because column is shorter
For i = LBound(valsProg, 1) To UBound(valsProg, 1)
If VBA.Trim$(valsMontant(i, 1)) <> vbNullString Then rowsToKeep.Add i
Next i
If rowsToKeep.Count < 1 Then
GetValsOut = Empty
Exit Function
End If
Dim output()
ReDim output(1 To rowsToKeep.Count, 1 To 3)
Dim nbRow As Long
For i = LBound(output, 1) To UBound(output, 1)
nbRow = rowsToKeep(i)
output(i, 1) = valsProg(nbRow, 1)
output(i, 2) = section
output(i, 3) = valsMontant(nbRow, 1)
Next i
GetValsOut = output
End Function
Private Sub CleanOutputSheet(outSht As Worksheet)
Application.ScreenUpdating = False
With outSht.Range("A3:C3")
Range(.Cells, .End(xlDown)).Clear
End With
Application.ScreenUpdating = True
End SubBonjour à tous
Avec une requête PowerQuery (intégré à Excel)
On pourrait importer les données externes aussi par PowerQuery ce qui allègerait le calcul
Bonjour à tous !
Une autre approche sur la base du classeur de 78chris (
let
Source = Excel.CurrentWorkbook(){[Name="Travaux"]}[Content],
Unpivot = Table.UnpivotOtherColumns(Source, {"PROG"}, "TRAVAUX", "MONTANT"),
Tri = Table.Sort(Table.SelectRows(Unpivot, each ([MONTANT] <> "") and ([PROG]<>"Total")),{{each List.PositionOf(Table.ColumnNames(Source),[TRAVAUX]),0},{"PROG",0}})
in
TriBonjour
Merci à JFL d'avoir éclairé ma lanterne : j'imaginais bien que ce type de commande existait
each List.PositionOf(Table.ColumnNames(Source)...plutôt que n commandes... sans compter le filtre incorporé....
Je la range dans mon grenier à astuces