Macro tableau max
Bonjour à tous,
J’espère que vous êtes en forme !
Je viens à vous pour effectuer une macro. On l’appellera « Tableau max »
J’aimerais que la macro analyse les données présentes dans la feuille « Reporting »
Sur cette feuille je vous emmène au Paraguay. Nous avons le bilan de chaque année d’une équipe selon certaines statistiques. Mon objectif est de créer un nouveau tableau qui me donne toutes les statistiques maximales d’une équipe sur toutes les saisons.
Ainsi, j’aimerai effectuer la macro dans la feuille « Tableau max »
L’idée est de dire à la macro : « Pour chaque nouvelle équipe présente à partir de la ligne 3 de la colonne B, tu recherches toutes les autres lignes en B qui ont le même nom. Puis pour chaque statistique, tu indiques la valeur maximale de chacune d’entre elles. Tu répètes cette action jusqu’à la dernière ligne où il y a du contenu. »
Dans notre feuille Reporting, nous avons 43 équipes différentes. L’idée est donc d’obtenir 43 lignes avec les statistiques maximales.
Je suis à votre disposition si vous avez des questions. Je vous remercie par avance pour votre aide.
Je vous souhaite par avance un bon week-end.
Laplacea
Salut laplacea,
premier jet...
Je ne renvoie pas de fichier : trop volumineux!
Pour les besoins de la cause, j'ai créé un bouton de commande ActiveX, nommé cmdMAX, dans 'PARAM' sous les deux autres et dont voici le code.
Private Sub cmdMAX_Click()
'
Dim tTab1, tTab2, tData, iCol%, iNb%, iStep%, sTeam$
'
With Worksheets("Reporting")
Worksheets("Tableau MAX").Cells.Delete
Worksheets("Tableau MAX").Range("A2").Resize(.Range("B" & Rows.Count).End(xlUp).Row - 2, 1).Value = _
.Range("B3:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
iCol = .Cells(2, Columns.Count).End(xlToLeft).Column
tTab1 = .Range("A3").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 2, iCol).Value
.Range("A3").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 2, iCol).Sort key1:=.Range("B3"), order1:=xlAscending, Orientation:=xlTopToBottom
tTab2 = .Range("B3").Resize(.Range("B" & Rows.Count).End(xlUp).Row - 1, iCol - 1).Value
End With
With Worksheets("Tableau MAX")
.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1
.Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=.Range("A2"), order1:=xlAscending, Orientation:=xlByRows
.Range("A1").Resize(1, iCol - 1).Value = Worksheets("Reporting").Range("B2").Resize(1, iCol - 1).Value
tData = .Range("A2").Resize(.Range("A" & Rows.Count).End(xlUp).Row - 1, iCol - 1).Value
End With
'
iStep = 1
sTeam = tTab2(1, 1)
For x = 2 To UBound(tTab2, 1)
If tTab2(x, 1) <> sTeam Then
iNb = iNb + 1
For y = 2 To UBound(tTab2, 2)
For Z = iStep To x - 1
tData(iNb, y) = IIf(CInt(tTab2(Z, y)) > CInt(tData(iNb, y)), tTab2(Z, y), tData(iNb, y))
Next
Next
sTeam = tTab2(x, 1)
iStep = x
End If
Next
Worksheets("Reporting").Range("A3").Resize(UBound(tTab1, 1), UBound(tTab1, 2)).Value = tTab1
With Worksheets("Tableau MAX")
.Range("A2").Resize(UBound(tData, 1), UBound(tData, 2)).Value = tData
.Columns.AutoFit
.Range("A2").Resize(UBound(tData, 1), UBound(tData, 2) - 1).HorizontalAlignment = xlHAlignCenter
.Activate
End With
'
End Sub
A+
Hello Curulis57,
Je te remercie pour ton retour et pour ton temps.
Ta macro fonctionne super bien du premier coup. Je t'en remercie beaucoup !
Pour le code de la macro, qu'est-ce que je dois changer pour pouvoir réaliser un copié-collé dans un module ? Parce qu'à chaque fois que je le copie-colle, je ne vois jamais la macro.
Je te remercie par avance pour ton retour Curulis. Je te souhaite un bon début de semaine !
Bonjour à toutes et tous,
Une autre proposition avec Récupérer et transformer (Power Query).
Pour l'actualisation de la requête : sélectionner une celleule de Tableau_Max ; clic-droit et Actualiser.
(Cette opération peut-être effectuée avec VBA.)
Cdlt.
let
Source = Excel.CurrentWorkbook(){[Name="Tableau_Reporting"]}[Content],
RemovedColumns = Table.RemoveColumns(Source,{"Exercice"}),
UnpivotedColumns = Table.UnpivotOtherColumns(RemovedColumns, {"Team", "NB FT G"}, "Attribute", "Value"),
GroupedRows = Table.Group(UnpivotedColumns, {"Team", "NB FT G", "Attribute"}, {{"Max", each List.Max([Value]), type number}}),
PivotedColumn = Table.Pivot(GroupedRows, List.Distinct(GroupedRows[Attribute]), "Attribute", "Max", List.Sum),
ReorderedColumns = Table.ReorderColumns(PivotedColumn,Titres)
in
ReorderedColumns
Salut Jean-Eric,
J'espère que tu vas bien.
Je te remercie pour ton retour et d'avoir proposé une solution. Celle-ci correspond également à ce que je cherche !
Je t'en remercie beaucoup et je te souhaite un bon après-midi !
Laplacea
Bonsoir à tous,
J'espère que vous allez bien.
Je reviens à vous car j'aimerai ajouter une action à la macro suivante
Public Sub Tableau_Aggregate()
Dim ws As Worksheet
For Each ws In ActiveWindow.SelectedSheets
TEST ws
Next
'Worksheets(1).Select
End Sub
Private Sub TEST(ws As Worksheet)
Dim lastRow As Long, lig As Long
Dim derncol As Integer
Dim tablig(), tabcol(), i As Byte, j As Integer
tablig = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20)
tabcol = Array("1,5", "2,5", "3,5", "4,5", "-1,5", "-2,5", "-3,5", "-4,5", "0,5", "1,5", "-0,5", "-1,5", "W", "D", "L")
Application.ScreenUpdating = False
With ws
.Activate
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
derncol = .Cells(2, Cells.Columns.Count).End(xlToLeft).Column + 2
If ws.Name <> "Aggregate" Then .Range("A2") = "Saison"
.Rows("2:2").Interior.ColorIndex = xlNone
.Rows("2:2").Font.Bold = True 'police en gras
.Cells(2, derncol) = "Total Match"
.Cells(3, derncol) = lastRow - 2
.Range(Cells(2, derncol), Cells(3, derncol)).Interior.Color = RGB(255, 230, 153)
.Cells(8, derncol + 1) = "FT": .Cells(38, derncol + 1) = "FT"
.Cells(8, derncol + 9) = "HT": .Cells(38, derncol + 9) = "HT"
.Cells(8, derncol + 13) = "WDL": .Cells(38, derncol + 13) = "WDL"
For i = 0 To UBound(tablig, 1) 'intitulés ligne (1 à 20)
.Cells(i + 10, derncol) = tablig(i) 'on remplit en colonne
.Cells(i + 40, derncol) = tablig(i) 'on remplit en colonne
.Range(Cells(10, derncol), Cells(29, derncol)).Interior.Color = RGB(255, 230, 153)
.Range(Cells(40, derncol), Cells(59, derncol)).Interior.Color = RGB(255, 230, 153)
Next i
For i = 0 To UBound(tabcol, 1) 'intitulés colonnes
.Cells(9, derncol - 1 + i + 2) = tabcol(i) 'on remplit en ligne
.Cells(39, derncol - 1 + i + 2) = tabcol(i) 'on remplit en ligne
.Range(Cells(9, derncol + 1), Cells(9, derncol + 4)).Interior.Color = RGB(194, 224, 180)
.Range(Cells(39, derncol + 1), Cells(39, derncol + 4)).Interior.Color = RGB(194, 224, 180)
.Range(Cells(9, derncol + 5), Cells(9, derncol + 8)).Interior.Color = RGB(248, 203, 173)
.Range(Cells(39, derncol + 5), Cells(39, derncol + 8)).Interior.Color = RGB(248, 203, 173)
.Range(Cells(9, derncol + 9), Cells(9, derncol + 12)).Interior.Color = RGB(189, 215, 238)
.Range(Cells(39, derncol + 9), Cells(39, derncol + 12)).Interior.Color = RGB(189, 215, 238)
.Range(Cells(9, derncol + 13), Cells(9, derncol + 15)).Interior.Color = RGB(217, 217, 217)
.Range(Cells(39, derncol + 13), Cells(39, derncol + 15)).Interior.Color = RGB(217, 217, 217)
Next i
For i = 10 To 29 'NB.SI premier tableau
.Cells(i, derncol + 1) = IIf(Application.WorksheetFunction.CountIf(ws.Range("I3:I" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("I3:I" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 2) = IIf(Application.WorksheetFunction.CountIf(ws.Range("K3:K" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("K3:K" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 3) = IIf(Application.WorksheetFunction.CountIf(ws.Range("M3:M" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("M3:M" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 4) = IIf(Application.WorksheetFunction.CountIf(ws.Range("O3:O" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("O3:O" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 5) = IIf(Application.WorksheetFunction.CountIf(ws.Range("Q3:Q" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("Q3:Q" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 6) = IIf(Application.WorksheetFunction.CountIf(ws.Range("S3:S" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("S3:S" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 7) = IIf(Application.WorksheetFunction.CountIf(ws.Range("U3:U" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("U3:U" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 8) = IIf(Application.WorksheetFunction.CountIf(ws.Range("W3:W" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("W3:W" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 9) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AB3:AB" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AB3:AB" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 10) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AD3:AD" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AD3:AD" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 11) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AF3:AF" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AF3:AF" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 12) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AH3:AH" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AH3:AH" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 13) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AJ3:AJ" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AJ3:AJ" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 14) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AK3:AK" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AK3:AK" & lastRow), .Cells(i, derncol)))
.Cells(i, derncol + 15) = IIf(Application.WorksheetFunction.CountIf(ws.Range("AL3:AL" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(ws.Range("AL3:AL" & lastRow), .Cells(i, derncol)))
Next i
'% deuxième tableau
i = 40
On Error Resume Next
.Cells(i, derncol + 1) = IIf(.Cells(i - 30, derncol + 1) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 1) / .Cells(3, derncol))
.Cells(i, derncol + 2) = IIf(.Cells(i - 30, derncol + 2) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 2) / .Cells(3, derncol))
.Cells(i, derncol + 3) = IIf(.Cells(i - 30, derncol + 3) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 3) / .Cells(3, derncol))
.Cells(i, derncol + 4) = IIf(.Cells(i - 30, derncol + 4) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 4) / .Cells(3, derncol))
.Cells(i, derncol + 5) = IIf(.Cells(i - 30, derncol + 5) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 5) / .Cells(3, derncol))
.Cells(i, derncol + 6) = IIf(.Cells(i - 30, derncol + 6) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 6) / .Cells(3, derncol))
.Cells(i, derncol + 7) = IIf(.Cells(i - 30, derncol + 7) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 7) / .Cells(3, derncol))
.Cells(i, derncol + 8) = IIf(.Cells(i - 30, derncol + 8) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 8) / .Cells(3, derncol))
.Cells(i, derncol + 9) = IIf(.Cells(i - 30, derncol + 9) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 9) / .Cells(3, derncol))
.Cells(i, derncol + 10) = IIf(.Cells(i - 30, derncol + 10) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 10) / .Cells(3, derncol))
.Cells(i, derncol + 11) = IIf(.Cells(i - 30, derncol + 11) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 11) / .Cells(3, derncol))
.Cells(i, derncol + 12) = IIf(.Cells(i - 30, derncol + 12) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 12) / .Cells(3, derncol))
.Cells(i, derncol + 13) = IIf(.Cells(i - 30, derncol + 13) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 13) / .Cells(3, derncol))
.Cells(i, derncol + 14) = IIf(.Cells(i - 30, derncol + 14) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 14) / .Cells(3, derncol))
.Cells(i, derncol + 15) = IIf(.Cells(i - 30, derncol + 15) / .Cells(3, derncol) = 0, "", .Cells(i - 30, derncol + 15) / .Cells(3, derncol))
For i = 41 To 59
.Cells(i, derncol + 1) = IIf(.Cells(i - 30, derncol + 1) / .Cells(i - 31, derncol + 1) = 0, "", .Cells(i - 30, derncol + 1) / .Cells(i - 31, derncol + 1))
.Cells(i, derncol + 2) = IIf(.Cells(i - 30, derncol + 2) / .Cells(i - 31, derncol + 2) = 0, "", .Cells(i - 30, derncol + 2) / .Cells(i - 31, derncol + 2))
.Cells(i, derncol + 3) = IIf(.Cells(i - 30, derncol + 3) / .Cells(i - 31, derncol + 3) = 0, "", .Cells(i - 30, derncol + 3) / .Cells(i - 31, derncol + 3))
.Cells(i, derncol + 4) = IIf(.Cells(i - 30, derncol + 4) / .Cells(i - 31, derncol + 4) = 0, "", .Cells(i - 30, derncol + 4) / .Cells(i - 31, derncol + 4))
.Cells(i, derncol + 5) = IIf(.Cells(i - 30, derncol + 5) / .Cells(i - 31, derncol + 5) = 0, "", .Cells(i - 30, derncol + 5) / .Cells(i - 31, derncol + 5))
.Cells(i, derncol + 6) = IIf(.Cells(i - 30, derncol + 6) / .Cells(i - 31, derncol + 6) = 0, "", .Cells(i - 30, derncol + 6) / .Cells(i - 31, derncol + 6))
.Cells(i, derncol + 7) = IIf(.Cells(i - 30, derncol + 7) / .Cells(i - 31, derncol + 7) = 0, "", .Cells(i - 30, derncol + 7) / .Cells(i - 31, derncol + 7))
.Cells(i, derncol + 8) = IIf(.Cells(i - 30, derncol + 8) / .Cells(i - 31, derncol + 8) = 0, "", .Cells(i - 30, derncol + 8) / .Cells(i - 31, derncol + 8))
.Cells(i, derncol + 9) = IIf(.Cells(i - 30, derncol + 9) / .Cells(i - 31, derncol + 9) = 0, "", .Cells(i - 30, derncol + 9) / .Cells(i - 31, derncol + 9))
.Cells(i, derncol + 10) = IIf(.Cells(i - 30, derncol + 10) / .Cells(i - 31, derncol + 10) = 0, "", .Cells(i - 30, derncol + 10) / .Cells(i - 31, derncol + 10))
.Cells(i, derncol + 11) = IIf(.Cells(i - 30, derncol + 11) / .Cells(i - 31, derncol + 11) = 0, "", .Cells(i - 30, derncol + 11) / .Cells(i - 31, derncol + 11))
.Cells(i, derncol + 12) = IIf(.Cells(i - 30, derncol + 12) / .Cells(i - 31, derncol + 12) = 0, "", .Cells(i - 30, derncol + 12) / .Cells(i - 31, derncol + 12))
.Cells(i, derncol + 13) = IIf(.Cells(i - 30, derncol + 13) / .Cells(i - 31, derncol + 13) = 0, "", .Cells(i - 30, derncol + 13) / .Cells(i - 31, derncol + 13))
.Cells(i, derncol + 14) = IIf(.Cells(i - 30, derncol + 14) / .Cells(i - 31, derncol + 14) = 0, "", .Cells(i - 30, derncol + 14) / .Cells(i - 31, derncol + 14))
.Cells(i, derncol + 15) = IIf(.Cells(i - 30, derncol + 15) / .Cells(i - 31, derncol + 15) = 0, "", .Cells(i - 30, derncol + 15) / .Cells(i - 31, derncol + 15))
Next i
If ws.Name <> "Aggregate" Then .Range("A2:A" & lastRow).Interior.Color = RGB(255, 255, 0) 'jaune
.Range("G2:N" & lastRow).Interior.Color = RGB(198, 224, 180) 'vert
.Range("O2:V" & lastRow).Interior.Color = RGB(248, 203, 173) 'orange
.Range("W2:AG" & lastRow).Interior.Color = RGB(189, 215, 238) 'bleu
.Range(Cells(40, derncol + 1), Cells(59, derncol + 15)).NumberFormat = "0.00%" 'format %
.Range(Cells(40, derncol + 1), Cells(40, derncol + 15)).Font.ColorIndex = 46: .Range(Cells(40, derncol + 1), Cells(40, derncol + 15)).Font.Bold = True 'police en orange et en gras
For lig = 3 To lastRow
If ws.Name <> "Aggregate" Then .Range("A" & lig) = ws.Name 'nom de l'onglet
Next lig
If ws.Name <> "Aggregate" Then
.Range("A2:AL2").BorderAround Weight:=xlThick 'encadrement plus épais ligne 2
For lig = 3 To lastRow
With .Range("A" & lig & ":AK" & lig)
.BorderAround Weight:=xlMedium 'encadrement ligne
.HorizontalAlignment = xlCenter 'centrage horizontal
.VerticalAlignment = xlCenter 'centrage vertical
End With
Next lig
Else
.Range("B2:AL2").BorderAround Weight:=xlThick 'encadrement plus épais ligne 2
For lig = 3 To lastRow
With .Range("B" & lig & ":AL" & lig)
.BorderAround Weight:=xlMedium 'encadrement ligne
.HorizontalAlignment = xlCenter 'centrage horizontal
.VerticalAlignment = xlCenter 'centrage vertical
End With
Next lig
End If
End With
End Sub
J'aimerai en en effet que celle-ci compte le nombre de fois que le nom de l'équipe apparait sur l'ensemble des feuilles situées à sa droite.
Par exemple, dans l'excel de mon premier message au Paraguay, la macro calculerait le nombre de fois que le nom d'une équipe apparait à partir de la feuille "07"
, jusqu'à la dernière.
Je vous remercie par avance de votre aide et je vous souhaite un bon début de semaine.
Laplacea
Bonsoir à tous, le forum,
Je me permets de vous relancer suite à mon dernier message.
Si vous avez des questions je suis disponible.
Je vous remercie par avance de votre retour.
Je vous souhaite une bonne soirée et un bon week-end.
Laplacea
Bonjour,
Joins un fichier pour une aide adaptée du forum.
Cdlt.