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= dernire 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