Macro pour mi-temps

Question

J'espère que vous allez bien. Je viens à vous car j'ai besoin d'aide pour réaliser une macro sur l'Excel suivant. J'aimerais que la macro réalise 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 : 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 &gt; 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 &lt; 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. Bien à vous et prenez soin de vous. Laplacea...

xorsankukai · Accepted Answer

Bonjour laplacea , le forum, Un essai....(je n'ai rien compris à ta macro, , je me suis donc contenté d'utiliser tes lignes de code ) Sub MACROHTT() Dim titrecolonne() Dim i As Integer, j As Long, dl As Long, x As Integer Application.ScreenUpdating = False titrecolonne = Array("0,5", "Série", "1,5", "Série", "-0,5", "Série", "-1,5", "Série")'...tableau contenant le titre des colonnes Z à AG nbserie = 2 For Each sh In ActiveWindow.SelectedSheets '...........................................agit sur chaque feuille sélectionnée sh.Activate '.................................................................active la feuille dl = sh.Range("B" & Rows.Count).End(xlUp).Row '...............................dernière ligne utilisée de la feuille For x = 0 To UBound(titrecolonne, 1) '.............................................boucle sur chaque titre du tableau titrecolonne sh.Cells(2, 26 + x) = titrecolonne(x): sh.Cells(2, 26 + x).Font.Bold = True '....écris titres en gras Next x For i = 3 To dl '...................................................................boucle de la ligne 3 à la dernière If sh.Range("W" & i) = "" And sh.Range("X" & i) = "" Then '........................si W et X sont vides alors sh.Range("y" & i) = "" '........................................................Y est vide également Else '............................................................................sinon : ta macro 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 &gt; 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 &lt; 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 End If '............................................................................fin de la première condition (w & x vides) Next i Next sh End Sub Cordialement...