VBA Journée - Date

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
laplacea
Membre habitué
Membre habitué
Messages : 81
Inscrit le : 5 janvier 2020
Version d'Excel : 2016 Microsoft

Message par laplacea » 3 avril 2020, 13:43

Bonjour à tous !

J'espère que vous vous portez bien en cette période difficile.

J'ai besoin de vous pour ce code :

Sub test()
Dim derlig As Long

Application.ScreenUpdating = False

With ActiveSheet 'agit sur la feuille active
If ActiveSheet.Name <> "Exemple" Then 'si le nom de la feuille est différent de Exemple
derlig = .Range("D" & Rows.Count).End(xlUp).Row 'dernière ligne utilisée de la colonne D

Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insert une colonne à gauche de la colonne B
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insert une colonne à gauche de la colonne C

.Range("B2") = "Série H": .Range("B2").Interior.ColorIndex = 6 'titre et couleur colonne B
.Range("C2") = "Série A": .Range("C2").Interior.ColorIndex = 6 'titre et couleur colonne C

.Range("B3").FormulaR1C1 = "=COUNTIF(R3C[3]:RC[4],RC[3])" 'ta formule en B3
.Range("B3:B" & derlig).FillDown 'on tire la formule jusqu'à la dernière ligne
.Range("C3").FormulaR1C1 = "=COUNTIF(R3C[2]:RC[3],RC[3])" 'ta formule en C3
.Range("C3:C" & derlig).FillDown 'on tire la formule jusqu'à la dernière ligne
Columns("B:C").HorizontalAlignment = xlCenter 'centrer horizontalement sur colonnes B et C
End If 'fin de la condition
End With
End Sub


Ce code s'applique uniquement sur la feuille activée et j'aimerai pouvoir l'utiliser sur les onglets que je sélectionne sur ma feuille de calcul. Pas toutes les feuilles mais seulement celles que j'aurai sélectionné au préalable pour y appliquer la macro.

Je vous remercie par avance de votre retour !

Laplacea
Test Flash Date.xlsm
(277.94 Kio) Téléchargé 6 fois
Avatar du membre
bouben
Membre impliqué
Membre impliqué
Messages : 1'795
Appréciations reçues : 54
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par bouben » 3 avril 2020, 14:27

Bonjour,

Une proposition en PJ.
Le traitement se fait sur l'onglet passé en paramètre.
Public Sub Test(poOnglet As Worksheet)
 
   With poOnglet                                              'agit sur l'onglet
Bouben
Test Flash Date_v0.1.xlsm
(278.43 Kio) Téléchargé 9 fois
Avatar du membre
laplacea
Membre habitué
Membre habitué
Messages : 81
Inscrit le : 5 janvier 2020
Version d'Excel : 2016 Microsoft

Message par laplacea » 5 avril 2020, 18:55

Bonjour,

Merci de ton retour et de ton aide !

Ca ne marche par car j'aimerai que tout le code listé dans le premier message de la discussion puisse se réaliser sur chaque onglet que j'aurai séléctionné avant d'utiliser la macro.

Je n'obtiens ce resultat avec la macro que tu as proposé. Il ajoute des colonnes mais n'effectue pas la macro sur les onglets que j'ai pu selectionner avant.

Est-il possible de le faire ?

Je te remercie beaucoup pour ton aide et à tous ceux qui liront ce message !

Bien à vous et prenez soin de vous.

Laplacea
Avatar du membre
bouben
Membre impliqué
Membre impliqué
Messages : 1'795
Appréciations reçues : 54
Inscrit le : 25 août 2014
Version d'Excel : 2010

Message par bouben » 5 avril 2020, 22:42

Bonsoir,

Dans le fichier envoyé :
> le nom de l'onglet est passé en paramètre
> la procédure est reprise telle quelle, en se basant non plus sur "ActiveSheet ", mais sur l'onglet passé en paramètre.

Pour lancer la procédure sur l'onglet X ou sur n onglets différents, il suffit d'appeler la procédure avec l'onglet (ou les onglets) en paramètre.

Un exemple est fourni, dans la procédure "XXXX", avec un seul onglet, il reste à dupliquer la ligne, avec tous les onglets à traiter
Public Sub XXXX()

    Test Worksheets("14-15")
    
End Sub
Tu as bien pris en compte ces différents points, avant de conclure que "ça ne marche pas" :-(

Si oui, merci de préciser davantage le résultat attendu ...

Bouben
G
GNIN
Membre habitué
Membre habitué
Messages : 74
Appréciations reçues : 6
Inscrit le : 6 février 2019
Version d'Excel : 2003
Version de Calc : 4.3

Message par GNIN » 5 avril 2020, 23:00

Bonjour,
Si j'ai bien compris tu souhaites que ta macro s'exécute uniquement sur les onglets sélectionnés.
Pour cela tu peux utiliser une procédure VBA qui boucle sur les onglets sélectionnés uniquement

Exemple de boucle:
Sub Traitement()
Dim F As Worksheet
For Each F In ActiveWindow.SelectedSheets
test F
Next F
End Sub

Ta procédure test est appelée dans la boucle et passe en paramètre la variable F qui représente l'onglet sélectionné en cours.

Dans ta procédure TEST il faut alors réceptionner la variable F et remplacer ActiveSheeet par F
exemple:
Sub test(F As Worksheet)
Dim derlig As Long

Application.ScreenUpdating = False

With F 'agit sur la feuille active
If F.Name <> "Exemple" Then 'si le nom de la feuille est différent de Exemple
derlig = .Range("D" & Rows.Count).End(xlUp).Row 'dernière ligne utilisée de la colonne D

Etc...

Bien cordialement,
Avatar du membre
xorsankukai
Membre impliqué
Membre impliqué
Messages : 2'316
Appréciations reçues : 263
Inscrit le : 7 octobre 2014
Version d'Excel : 2010 FR

Message par xorsankukai » 6 avril 2020, 09:52

Bonjour tout le monde, (°v°)°


Un essai....les onglets sont selectionnés manuellement avant d'exécuter la macro...
Sub test()
 Dim derlig As Long
 Dim sh As Worksheet

Application.ScreenUpdating = False

 For Each sh In ActiveWindow.SelectedSheets
  If sh.Name <> "Exemple" Then 'si le nom de la feuille selectionnée est différent de Exemple
    sh.activate
   derlig = sh.Range("D" & Rows.Count).End(xlUp).Row 'dernière ligne utilisée de la colonne D

   sh.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insert une colonne à gauche de la colonne B
   sh.Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'insert une colonne à gauche de la colonne C

   sh.Range("B2") = "Série H": sh.Range("B2").Interior.ColorIndex = 6 'titre et couleur colonne B
   sh.Range("C2") = "Série A": sh.Range("C2").Interior.ColorIndex = 6 'titre et couleur colonne C

   sh.Range("B3").FormulaR1C1 = "=COUNTIF(R3C[3]:RC[4],RC[3])" 'ta formule en B3
   sh.Range("B3:B" & derlig).FillDown 'on tire la formule jusqu'à la dernière ligne
   sh.Range("C3").FormulaR1C1 = "=COUNTIF(R3C[2]:RC[3],RC[3])" 'ta formule en C3
   sh.Range("C3:C" & derlig).FillDown 'on tire la formule jusqu'à la dernière ligne
   sh.Columns("B:C").HorizontalAlignment = xlCenter 'centrer horizontalement sur colonnes B et C
  End If 'fin de la condition
 Next sh
End Sub
EDIT: Oups! En fait c'est la même réponse que GNIN, :P , désolé, j'ai répondu trop vite.



Cordialement,
xorsankukai

La connaissance, c’est partager le savoir qui nous fait grandir.
Avatar du membre
xorsankukai
Membre impliqué
Membre impliqué
Messages : 2'316
Appréciations reçues : 263
Inscrit le : 7 octobre 2014
Version d'Excel : 2010 FR

Message par xorsankukai » 6 avril 2020, 10:32

Re,

La réponse que je t'avais apportée (après moult tentatives, :lole: ) ne te satisfait donc plus ? ::(
viewtopic.php?p=852845#p852845

Un essai à partir de ma dernière proposition....
  • Sélectionnes tes onglets
  • CTRL + e pour exécuter la macro...
Macro série.V3.xlsm
(537.14 Kio) Téléchargé 1 fois

Cordialement,
xorsankukai

La connaissance, c’est partager le savoir qui nous fait grandir.
Avatar du membre
laplacea
Membre habitué
Membre habitué
Messages : 81
Inscrit le : 5 janvier 2020
Version d'Excel : 2016 Microsoft

Message par laplacea » 6 avril 2020, 12:16

Hello à tous ! J'espere que vous vous portez bien

Merci pour vos retours !

xorsankukai, je souhaitais éviter de te sursolliciter ahah ! Je voulais ajouter un élément par rapport au post précédent.

En tout cas tu es toujours aussi réactif !

Peux-tu réaliser la même chose sur les onglets sélectionnés avant d'utiliser la macro avec le code suivant :

" Option Explicit
Sub Macro1()
'
Dim nbserie&, i&, j&, dl&, ng&

nbserie = 3 ' nbseries à créer, progression linéaire

With ActiveSheet

dl = .Cells(Rows.Count, 2).End(xlUp).Row 'dl= dernière ligne utilisée en colonne 2 (colonne B)

For j = 1 To nbserie ' titre colonne en ligne 2
.Cells(2, 6 + j * 2) = "Serie"
.Cells(2, 5 + j * 2) = j + 0.5
Next j

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

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 .Cells(i - 1, 3) = .Cells(i, 3) Then 'equipe sur la ligne = equipe sur la ligne précédente
.Cells(i, 6 + j * 2) = .Cells(i - 1, 6 + j * 2) + 1 'incremente compteur de la série
'sinon
Else
.Cells(i, 6 + j * 2) = 1 'initialise compteur à 1
End If
.Cells(i, 5 + j * 2) = "Oui" 'score pivot dépassé
Else
.Cells(i, 6 + j * 2) = 0 'initialise compteur à 0
.Cells(i, 5 + j * 2) = "Non" 'score pivot pas dépassé
End If

Next j 'série suivante

Next i 'ligne suivante

End With
'
End Sub
"


Je te remercie par avance !

Laplacea
Avatar du membre
laplacea
Membre habitué
Membre habitué
Messages : 81
Inscrit le : 5 janvier 2020
Version d'Excel : 2016 Microsoft

Message par laplacea » 6 avril 2020, 12:18

Avec un fichier test en PJ :)

Merci d'avance !
Test macro.xlsm
(297.88 Kio) Téléchargé 3 fois
Avatar du membre
xorsankukai
Membre impliqué
Membre impliqué
Messages : 2'316
Appréciations reçues : 263
Inscrit le : 7 octobre 2014
Version d'Excel : 2010 FR

Message par xorsankukai » 6 avril 2020, 13:28

Re,

Ton fichier en retour.....à tester (j'ai fait la modif.sur les 3 macros).....

Il suffisait de remplacer
With ActiveSheet
End With
par
For Each sh In ActiveWindow.SelectedSheets
sh.activate
'le code
next sh
Et rajouter
sh
devant les
.cells
Option Explicit
Sub Macro1()
'
Dim nbserie&, i&, j&, dl&, ng&
Dim sh As Worksheet

nbserie = 3                                                               ' nbseries à créer, progression linéaire

For Each sh In ActiveWindow.SelectedSheets
         sh.Activate
    dl = sh.Cells(Rows.Count, 2).End(xlUp).Row                            'dl= dernière ligne utilisée en colonne 2 (colonne B)
 
 For j = 1 To nbserie                                                     ' titre colonne en ligne 2
      sh.Cells(2, 6 + j * 2) = "Serie"
      sh.Cells(2, 5 + 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, 4) + sh.Cells(i, 5)                                     'ng nombres de goals =somme colonne D+colonne E pour la ligne i
      sh.Cells(i, 6) = ng                                                 'mettre nombre de goals en colonne F

 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, 6 + j * 2) = sh.Cells(i - 1, 6 + j * 2) + 1            'incremente compteur de la série
    Else
       sh.Cells(i, 6 + j * 2) = 1                                         'initialise compteur à 1
    End If
       sh.Cells(i, 5 + j * 2) = "Oui"                                     'score pivot dépassé
   Else
       sh.Cells(i, 6 + j * 2) = 0                                         'initialise compteur à 0
       sh.Cells(i, 5 + j * 2) = "Non"                                     'score pivot pas dépassé
   End If
 Next j                                                                   'série suivante
 Next i                                                                   'ligne suivante
Next sh
End Sub

Copie de Test macro.xlsm
(273.37 Kio) Téléchargé 5 fois

Cordialement,
xorsankukai

La connaissance, c’est partager le savoir qui nous fait grandir.
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message