Macro série mi-temps

Bonjour à tous !

J'espère que vous allez bien.

Je viens à vous pour réaliser une macro sur ce fichier :

La macro doit effectuer les actions suivantes :Pour toutes les feuilles sélectionnées et pour chaque ligne à partir de la 3e, tu vas selon 2 cas :

1er cas : feuille orange - si les colonnes W et X (HTHG & HTAG) sont vides à partir de la ligne 3 :

On démarre avec cette situation

1 - Tu supprimes toutes les données à partir de la ligne 3 dans la colonne Y (NBHTG). Le but est d'enlever les 0

2 - Tu nommes Z2 : "0.5", AA2 : "Série", AB2 : "1.5", AC2 : "Série", AD2 : "-0.5", AE2 : "Série", AF2 : "-1.5", AG2 : "Série"

Ainsi on termine ainsi :

2ᵉ cas : feuille bleue - si les colonnes W et X (HTHG & HTAG) sont remplies à partir de la ligne 3 :

On applique le code suivant :

Sub Macro5_flashresultat_serieHT()
'
' Macro5_flashresultat_serieHT Macro
'
Dim nbserie&, i&, j&, dl&, ng&
Dim sh As Worksheet

Columns("AB:AI").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

nbserie = 2                                                              ' nbseries ˆ crŽer, progression linŽaire

For Each sh In ActiveWindow.SelectedSheets
         sh.Activate
    dl = sh.Cells(Rows.Count, 25).End(xlUp).Row                            'dl= dernire ligne utilisŽe en colonne 2 (colonne B)

 For j = 0 To nbserie - 1                                                  ' titre colonne en ligne 2
      sh.Cells(2, 27 + j * 2) = "Serie"
      sh.Cells(2, 26 + j * 2) = j + 0.5
 Next j

 For i = 3 To dl                                                          'on parcourt toutes les lignes
   If sh.Cells(i, 2) = "" Then Exit For                                   'on quitte la boucle si journŽe=""
 ng = sh.Cells(i, 23) + sh.Cells(i, 24)                                     'ng nombres de goals =somme colonne D+colonne E pour la ligne i
      sh.Cells(i, 25) = ng                                                 'mettre nombre de goals en colonne F

 For j = 0 To nbserie - 1                                                    ' nbseries ˆ crŽer
   If ng > j + 0.5 Then                                                   'test si nombre de goals supŽrieur ˆ la valeur pivot pour la sŽrie j ( donc 1.5 pour sŽrie 1, 2.5 pour sŽrie 2, ....)
    If sh.Cells(i - 1, 3) = sh.Cells(i, 3) Then                           'equipe sur la ligne = equipe sur la ligne prŽcŽdente
       sh.Cells(i, 27 + j * 2) = sh.Cells(i - 1, 27 + j * 2) + 1            'incremente compteur de la sŽrie
    Else
       sh.Cells(i, 27 + j * 2) = 1                                         'initialise compteur ˆ 1
    End If
       sh.Cells(i, 26 + j * 2) = "Oui"                                     'score pivot dŽpassŽ
   Else
       sh.Cells(i, 27 + j * 2) = 0                                         'initialise compteur ˆ 0
       sh.Cells(i, 26 + j * 2) = "Non"                                     'score pivot pas dŽpassŽ
   End If
 Next j                                                                   'sŽrie suivante
 'test

  For j = 1 To nbserie                                                     ' titre colonne en ligne 2
      sh.Cells(2, 29 + j * 2) = "Serie"
      sh.Cells(2, 28 + j * 2) = -(j - 0.5)
 Next j

 For j = 1 To nbserie                                                     ' nbseries ˆ crŽer
   If ng < j - 0.5 Then                                                   'test si nombre de goals supŽrieur ˆ la valeur pivot pour la sŽrie j ( donc 1.5 pour sŽrie 1, 2.5 pour sŽrie 2, ....)
    If sh.Cells(i - 1, 3) = sh.Cells(i, 3) Then                           'equipe sur la ligne = equipe sur la ligne prŽcŽdente
       sh.Cells(i, 29 + j * 2) = sh.Cells(i - 1, 29 + j * 2) + 1            'incremente compteur de la sŽrie
    Else
       sh.Cells(i, 29 + j * 2) = 1                                         'initialise compteur ˆ 1
    End If
       sh.Cells(i, 28 + j * 2) = "Oui"                                     'score pivot dŽpassŽ
   Else
       sh.Cells(i, 29 + j * 2) = 0                                         'initialise compteur ˆ 0
       sh.Cells(i, 28 + j * 2) = "Non"                                     'score pivot pas dŽpassŽ
   End If
 Next j                                                                   'sŽrie suivante

 Next i                                                                   'ligne suivante
Next sh
End Sub

Je vous remercie par avance pour votre aide et de votre temps.

Je me montre disponible aux besoins !

Bien à vous et prenez soin de vous.

Laplacea

Bonjour à tous,

Je me permets ce petit message de relance.

Je vous souhaite à tous une excellente semaine !

Laplacea

Bonjour à tous,

J'espère que vous profitez bien de cette chaleur.

Je viens à vous pour relancer le sujet.

Je vous remercie par avance de votre temps et de vos retours.

Je suis à votre disposition si vous avez des questions.

Prenez soin de vous et de vos proches !

Laplacea