Tableau synthèse

Le 19/06/2020 à 14:34

Bonjour à tous le forum,

Bonjour le forum,

J’espère que vous allez bien.

Je viens à vous pour créer une macro qui réplique le tableau présent dans la feuille "Résultat" avec les actions suivantes :

À partir des feuilles sélectionnées avant d’activer la macro :

- Partir de 2 colonnes à droite de la dernière colonne qui du contenu

- Créer une case Total match et à la ligne en dessous, compter le nombre de lignes qui a du contenu(par exemple partir de la colonne B « TEAM ».

- Créer le 1er tableau avec la même mise en forme et couleur de fond si possible. Le but est que pour chaque colonne, la macro compte le nombre de lignes où le nombre apparait dans la colonne présente dans l’ensemble de données (On peut retrouver la colonne dans la formule). On peut dans la macro écrire directement le numéro de colonne car toutes les feuilles qui utiliseront la macro auront le même format.

Exemple : En prenant la colonne « FT 1,5 » dans la colonne AO, la macro devra partir de la ligne 3 de la colonne H et passer en revue toutes les lignes de cette colonne H pour voir le nombre de fois que le chiffre 1 apparait. Puis ma macro répètera lorsque le chiffre 2 apparait dans la colonne H, etc. Et ceux jusqu’à 20.

- Une fois cette tache réalisée par la macro, j’aimerais que la macro supprime tous les 0 du tableau. Cela sera utile pour le tableau suivant.

- Pour le tableau suivant (3 lignes en dessous du précédent), j’aimerais que la macro effectue les calculs présents en formule en mettant en orange et en gras le contenu pour la ligne « 1 »

Je suis à votre disposition au besoin.

Je vous remercie d'avance pour votre aide et pour votre temps.

Passez un bon après-midi !

Laplacea

10tableau-aggregate-exemple.xlsx (540.86 Ko)
16tableau-aggregate-resultat.xlsx (556.68 Ko)
Le 24/06/2020 à 14:22

Bonjour le forum,

Petit message de relance. ^^

Je vous souhaite un bon après-midi !

Laplacea

Le 25/06/2020 à 14:19

Bonjour laplacea, le forum,

Un essai.....c'est une petite usine à gaz mais bon...il y a sans doute moyen de faire plus simple....

Je te laisse le soin de vérifier les résultats,

Toujours pareil : tu sélectionnes tes onglets puis ctrl + e

10macro-saisonv3-1.xlsm (625.99 Ko)

Cordialement,

Le 25/06/2020 à 15:13

Bonjour xorsankukai, le forum,

Je te remercie pour ton retour et pour le temps que tu as accordé à ma demande.

C'est vraiment propre. Bravo.

Juste pour le deuxième tableau, j'aimerai effectuer un autre calcul que celui que tu as fait. J'aimerai connaître le pourcentage de cas qui passe à la série supérieure. Par exemple, dans la feuille "11", j'aimerai connaitre dans la cellule AN41 le pourcentage de cas qui passe de la serie 1 (146) à la série 2 (110): 110/146 = 75,34%, et ainsi de suite pour chaque ligne.

capture tableua

J'espère que c'est compréhensible, je te revois le fichier avec les formules en exemple au cas ou ^^.

Je te remercie d'avance Xorsankukai. je te souhaite un bon après-midi.

Laplacea

5macro-saisonv3-1.xlsm (551.53 Ko)
Le 25/06/2020 à 17:53

Re,

Nouvel essai.....de ce que j'ai compris.....

Pour la ligne 1 tu tableau 2 : ligne 1 du tableau 1 / Total match (résultat en orange)

Pour la ligne 2 tu tableau 2 : ligne 2 du tableau 1 / ligne 1 du tableau 1

Pour la ligne 20 tu tableau 2 : ligne 20 du tableau 1 / ligne 19 du tableau 1

11macro-saisonv3-2.xlsm (627.74 Ko)

Cordialement,

Le 28/06/2020 à 16:00

Bonjour Xorsankukai, le forum,

Je te remercie pour ton retour, je vais faire une reponse combiné avec ce sujet https://forum.excel-pratique.com/excel/macro-saison-mise-en-page-143419, car il se ressemble beaucoup à l'arrivé ^^.

C'est vraiment top ce que tu as fait dans la macro. J'aimerai ajouter une condition afin de pouvoir l'utiliser correctement sur toutes mes feuilles de calculs.

Dans la macro, je souhaitais qu'à partir de la 3ème ligne de la colonne A et ceux jusqu'à la dernière ligne où il y a du contenu, d'écrire le nom de la feuille (11;12;17 etc.) J'aimerai ajouter une condition où si elle traite la feuille "Aggregate", qu'elle ne le fasse pas car j'obtiens ce resultat ci-dessous. ^^'

aggrzgaez probleme

En tout cas merci beaucoup Xorsankukai et je te souhaite un bon après-midi !

Laplacea

Le 28/06/2020 à 16:23

Bonjour laplacea, le forum,

J'aimerai ajouter une condition où si elle traite la feuille "Aggregate", qu'elle ne le fasse pas

A tester:

 With ws
     If ws.Name <> "Aggregate" Then
     ....
     end if
 End with
6macro-saison-v3-3.zip (515.89 Ko)

Cordialement,

Le 29/06/2020 à 22:44

Bonsoir Xorsankukai, le forum,

Je te remercie pour ton retour,j'espère que tu vas bien.

Je crois que je me suis mal exprimé excuse-moi. ^^

En fait, j'aimerais qu'une partie seulement de la macro ne s'exécute pas sur la feuille "Aggregate" et non toute la macro.

J'aimerais que la partie de la macro qui effectue l'action d'ajouter dans la colonne A le nom de la feuille ne le fasse pas sur la feuille "Aggregate"(surligné en jaune ci-dessous). En revanche, la macro peut effectuer toutes les autres actions sur la feuille "Aggregate"

Je te remercie par avance de ton retour. Je te souhaite une bonne soirée Xorsankukai.

Laplacea

Le 30/06/2020 à 08:54

Bonjour laplacea, le forum,

Je crois que je me suis mal exprimé excuse-moi. ^^

Où c'est moi qui n'est pas compris ta demande,

Nouvelle tentative...

8macro-saison-v3-4.zip (517.16 Ko)

As-tu obtenu satisfaction ici: https://forum.excel-pratique.com/s/goto/883353 ?

Cordialement,

Le 01/07/2020 à 02:06

Hello Xorsankukai, le forum,

J'espère que tu vas bien. :)

La macro est nickel je t'en remercie de nouveau. :)

Je viens de te répondre sur le sujet : https://forum.excel-pratique.com/s/goto/883353

Je te souhaite une bonne soirée et merci encore pour ce temps que tu m'accordes à chaque fois pour progresser et aller de l'avant !

Laplacea

Le 01/07/2020 à 08:08

Merci pour tes retours,

N'oublie pas de clôturer le sujet si tu considères que ton problème est résolu.

A bientôt,

Cordialement,

Le 20/07/2020 à 01:51

Bonsoir Xorsankukai, le forum,

J'aimerais te demander d'ajouter un détail dans le code de la macro suivant :

J'aimerai que la macro fasse toute ces actions directement sur la feuille "Aggregate", plutôt que d'aller sur la feuille Aggregate à chaque fois (ce que je t'avais demandé initialement )

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

Je te remercie par avance pour ton retour et je te souhaite une bon début de semaine !

Laplacea

Le 22/07/2020 à 11:54

Bonjour laplacea, le forum,

J'aimerai que la macro fasse toute ces actions directement sur la feuille "Aggregate", plutôt que d'aller sur la feuille Aggregate à chaque fois (ce que je t'avais demandé initialement )

Désolé, mais je ne comprends pas ta demande....

Que veux-tu modifier ?

Cordialement,

Le 24/07/2020 à 14:51

Hello Xorsankukai, le forum,

Je te remercie pour ton retour.

J'aimerai simplement ajouter une ligne de code pour spécifier à la macro de fonctionner uniquement sur la feuille "Aggregate", et non les feuilles sélectionnées.

Je te remercie par avance de ton retour et je te souhaite une bonne journée !

Le 24/07/2020 à 16:13

Salut laplacea,

Bonjour le forum,

J'aimerai simplement ajouter une ligne de code pour spécifier à la macro de fonctionner uniquement sur la feuille "Aggregate"

Macro modifiée pour agir uniquement sur la feuille Aggregate....à tester...

Sub AGGREGATE()
  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 Sheets("Aggregate")
        .Activate
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        derncol = .Cells(2, Cells.Columns.Count).End(xlToLeft).Column + 2

        .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(.Range("H3:H" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("H3:H" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 2) = IIf(Application.WorksheetFunction.CountIf(.Range("J3:J" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("J3:J" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 3) = IIf(Application.WorksheetFunction.CountIf(.Range("L3:L" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("L3:L" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 4) = IIf(Application.WorksheetFunction.CountIf(.Range("N3:N" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("N3:N" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 5) = IIf(Application.WorksheetFunction.CountIf(.Range("P3:P" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("P3:P" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 6) = IIf(Application.WorksheetFunction.CountIf(.Range("R3:R" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("R3:R" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 7) = IIf(Application.WorksheetFunction.CountIf(.Range("T3:T" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("T3:T" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 8) = IIf(Application.WorksheetFunction.CountIf(.Range("V3:V" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("V3:V" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 9) = IIf(Application.WorksheetFunction.CountIf(.Range("AA3:AA" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AA3:AA" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 10) = IIf(Application.WorksheetFunction.CountIf(.Range("AC3:AC" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AC3:AC" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 11) = IIf(Application.WorksheetFunction.CountIf(.Range("AE3:AE" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AE3:AE" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 12) = IIf(Application.WorksheetFunction.CountIf(.Range("AG3:AG" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AG3:AG" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 13) = IIf(Application.WorksheetFunction.CountIf(.Range("AI3:AI" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AI3:AI" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 14) = IIf(Application.WorksheetFunction.CountIf(.Range("AJ3:AJ" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AJ3:AJ" & lastRow), .Cells(i, derncol)))
        .Cells(i, derncol + 15) = IIf(Application.WorksheetFunction.CountIf(.Range("AK3:AK" & lastRow), .Cells(i, derncol)) = 0, "", Application.WorksheetFunction.CountIf(.Range("AK3:AK" & 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

        .Range("B2:AK2").BorderAround Weight:=xlThick     'encadrement plus épais ligne 2
      For lig = 3 To lastRow
       With .Range("B" & lig & ":AK" & lig)
        .BorderAround Weight:=xlMedium                    'encadrement ligne
        .HorizontalAlignment = xlCenter                   'centrage horizontal
        .VerticalAlignment = xlCenter                     'centrage vertical
       End With
      Next lig
    End With
End Sub

Cordialement,

Le 27/07/2020 à 19:15

Hello Xorsankukai, le forum,

Merci pour ton retour !

Ça fonctionne super bien !

Passes une bonne soirée.

Laplacea

Le 29/07/2020 à 10:02

Bonjour Adrien,

Ça fonctionne super bien !

Merci pour ton retour,

A bientôt,

Rechercher des sujets similaires à "tableau synthese"