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. »

tableau

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

1'062macro-tableau-max.zip (1.37 Mo)

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+

Finalement, en supprimant les feuilles numérotées, ça passe très bien.


A+

6paraguay.xlsm (65.38 Ko)

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.

Rechercher des sujets similaires à "macro tableau max"