Pointage des X devenant des P ( RESOLU )

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion JBARBE
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
JBARBE

JBARBE

XLDnaute Barbatruc
Bonjour à tous,

J'ai fait une macro qui marche mais qui doit ramer sur plusieurs lignes !

Je m'explique : Lorsque je clic sur le bouton "pointage" alors que le solde total est vide, celui-ci se rempli !

Ensuite j'ai la colonne à côté "pointage des P" qui se rempli lorsque je mets des "X" dans la colonne A et que le clic à nouveau sur le bouton " pointage"!

Je voudrais savoir si une macro plus rapide peut-être faite avec les fonctions qui lui sont attribués dans mon exemple !

Code: 
Option Explicit

Sub Pointage_des_X()
Dim I As Long
 Application.ScreenUpdating = False
 Range("Effacer").ClearContents
 Range("H1") = Range("E1")
 If Cells(4, 1) = "" Then
   Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  ElseIf Cells(4, 1) = "P" Then
   Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  Cells(4, 8) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  Range("H1") = Cells(4, 9)
  ElseIf Cells(4, 1) = "X" Then
     Cells(4, 8) = Range("H1") + Cells(4, 6) - Cells(4, 5)
     Cells(4, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
     Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
      Cells(4, 1) = "P"
      Range("H1") = Cells(4, 8)
  End If
For I = 5 To 65536
   If Cells(I, 2) = "" Then Exit Sub
   If Cells(I, 1) = "" Then
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
   ElseIf Cells(I, 1) = "X" Then
     Cells(I, 8) = Range("H1") + Cells(I, 6) - Cells(I, 5)
     Cells(I, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = Cells(I, 8)
     Cells(I, 1) = "P"
     ElseIf Cells(I, 1) = "P" Then
     Cells(I, 8) = Range("H1") + Cells(I, 6) - Cells(I, 5)
     Cells(I, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = Cells(I, 8)
   End If
Next I
 Application.ScreenUpdating = True

End Sub

J'ai modifié la macro parce qu'elle ne tenait pas compte des P déjà fait ! 18 h 30

Merci à l'avance !
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Re : Pointage des X devenant des P

JCGL à dit:
Bonjour à tous,

Peut-être en diminuant la nombre de lignes à tester :


par


A+ à tous
Cliquez pour agrandir...

Bonjour à tous,

Je ne pense pas que cela soit la solution puisque la macro quelque soit le nombre de lignes, doit travailler de bas en haut ( solution proposée) ou de haut en bas !

Peut-être avec un For Each à la place d'un For I !!!!!!!!

Code: 
Sub Pointage_X()
Dim C As Range
 Application.ScreenUpdating = False
 Range("Effacer").ClearContents
 Range("H1") = Range("E1")
 If Cells(4, 1) = "" Then
   Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  ElseIf Cells(4, 1) = "P" Then
   Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  Cells(4, 8) = Range("H1") + Cells(4, 6) - Cells(4, 5)
  Cells(4, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
  Range("H1") = Cells(4, 9)
  ElseIf Cells(4, 1) = "X" Then
     Cells(4, 8) = Range("H1") + Cells(4, 6) - Cells(4, 5)
     Cells(4, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(4, 9) = Range("H1") + Cells(4, 6) - Cells(4, 5)
     Cells(4, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
      Cells(4, 1) = "P"
      Range("H1") = Cells(4, 8)
  End If
For Each C In Range("A5:A65536")
 C.Select
   If C = "" And ActiveCell.Offset(0, 1) <> "" Then
     ActiveCell.Offset(0, 8) = ActiveCell.Offset(-1, 8) + ActiveCell.Offset(0, 5) - ActiveCell.Offset(0, 4)
     ActiveCell.Offset(0, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
   ElseIf C = "X" And ActiveCell.Offset(0, 1) <> "" Then
     ActiveCell.Offset(0, 7) = Range("H1") + ActiveCell.Offset(0, 5) - ActiveCell.Offset(0, 4)
     ActiveCell.Offset(0, 7).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     ActiveCell.Offset(0, 8) = ActiveCell.Offset(-1, 8) + ActiveCell.Offset(0, 5) - ActiveCell.Offset(0, 4)
     ActiveCell.Offset(0, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = ActiveCell.Offset(0, 7)
     ActiveCell = "P"
     ElseIf C = "P" And ActiveCell.Offset(0, 1) <> "" Then
     ActiveCell.Offset(0, 7) = Range("H1") + ActiveCell.Offset(0, 5) - ActiveCell.Offset(0, 4)
     ActiveCell.Offset(0, 7).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     ActiveCell.Offset(0, 8) = ActiveCell.Offset(-1, 8) + ActiveCell.Offset(0, 5) - ActiveCell.Offset(0, 4)
     ActiveCell.Offset(0, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = ActiveCell.Offset(0, 7)
     Else
     Exit Sub
   End If
Next C
 Application.ScreenUpdating = True

End Sub

S'il y a une proposition permettant une plus grande rapidité de l’exécution de ma macro, je suis preneur !

Bonne journée et Merci à l'avance !
 
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Bonjour à tous ,

a priori l'on parcours l"ensemble des lignes.

en intégrant une recherche de la derniere ligne qui serait ensuite passée en limite haute de boucle .

Code: 
 Fin = Range("B" & Rows.Count).End(xlUp).Row
 For I = 5 To Fin
   If Cells(I, 2) = "" Then Exit Sub
   If Cells(I, 1) = "" Then
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
   ElseIf Cells(I, 1) = "X" Then
     Cells(I, 8) = Range("H1") + Cells(I, 6) - Cells(I, 5)
     Cells(I, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = Cells(I, 8)
     Cells(I, 1) = "P"
     ElseIf Cells(I, 1) = "P" Then
     Cells(I, 8) = Range("H1") + Cells(I, 6) - Cells(I, 5)
     Cells(I, 8).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Cells(I, 9) = Cells(I - 1, 9) + Cells(I, 6) - Cells(I, 5)
     Cells(I, 9).NumberFormat = "###0.00 ""€"";[Red]-###0.00 ""€"""
     Range("H1") = Cells(I, 8)
   End If
Next I
 Application.ScreenUpdating = True
 
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Re

Je viens de penser:
Et si on utilisait SpecialCells ?

Jean-Marcel
Tu veux pas titiller de l'End(xlUp) et de l'Application.Rows.Count ?
Allez, sois pas timide, rejoins le club des 3, pour en faire le club des 4 😉
 
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Bonjour à tous 🙂,
Ce qui me surprend le plus dans tout ça, c'est l'entêtement à remettre un format de cellule, toujours identique, a chaque passage et cellule par cellule.....😀 C'est peut être un temps de traitement inutile non ?
Cordialement
 
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Re

Efgé
Toi qui me hais, ne viens pas concurrencer mon club des Trois, avec ton club mono-membre !
Même si je dois avouer que t'as pas tort sur ce coup-là 😉

NB: Pour les lecteurs non-avertis, Efgé et moi sommes en mode private joke 😉
(Enfin j'espère sinon il me faudra vivre avec cette idée d'une haine véritable et féroce, de celles qui font peur et peuplent les nuits de cauchemars effrayants)
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Merci Jean Marcel pour ta réponse objective !


Il faut sortir de la macro > exit sub au lieu de la boucle > exit for : camarchepas !

J'ai fait un essai ( voir fichier ci-joint avec les différentes macro) sur 368 lignes - 3 et je ne pense pas qu'en supprimant les select cela améliore la rapidité de la macro !

Néanmoins, sur 365 lignes le temps de calcul reste correct mais sur la saisie d'une année (ici 2014) les lignes peuvent doubler !

Encore une fois merci Jean Marcel !
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Efgé à dit:
Bonjour à tous 🙂,
Ce qui me surprend le plus dans tout ça, c'est l'entêtement à remettre un format de cellule, toujours identique, a chaque passage et cellule par cellule.....😀 C'est peut être un temps de traitement inutile non ?
Cordialement
Cliquez pour agrandir...

Merci Efgé pour ta réponse !

En effet, j'ai bien pensé à cette particularité mais si l'on vient à supprimer une ligne ou un pointage X devenu P par conséquence, il faudra quand même balayer chaque cellule depuis le début pour ne pas avoir d'erreur dans le solde des P ou le solde Total pour la ligne supprimée !!

Quant au format, je pense que cela est nécessaire pour chaque cellule nouvelle !
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Re

JBARBE
JCGL, camarchepas, Efgé et moi-même étions objectifs.
Et nos infos concernant VBA exactes.
La seule chose que tu peux ne pas apprécier (dans mon cas) est mon sens de l'humour.
Mais concernant ta boucle, il n'est pas utile de boucler sur 65536 lignes (sauf si tu utilises 65536 lignes)
C'est tout ce que nous tentions de te dire 😉
(Et c'est ce que l'on voit dans de nombreuses discussions où l'on parle de DerLig et où on utilise la syntaxe que nous évoquons)
 
Vote positif 0 Vote négatif
Re : Pointage des X devenant des P

Re
@ JBARBE

JBARBE à dit:
En effet, j'ai bien pensé à cette particularité mais si l'on vient à supprimer une ligne ou un pointage X devenu P par conséquence, il faudra quand même balayer chaque cellule depuis le début pour ne pas avoir d'erreur dans le solde des P ou le solde Total pour la ligne supprimée !!
Cliquez pour agrandir...

Nous sommes, peut être, d'accord sur une boucle, bien que je pense, comme tous le monde, qu'il faudrait limiter la casse (.End(3).row ou exit sub, ou.... ),mais limiter la casse.
Pär contre, si tu sélectionne tes deux colonnes, que tu applique le mondialement célèbre format ###0.00 "€";[Red]-###0.00 "€"
J'aimerais comprendre pourquoi le re mettre puis la prochaine fois le re re mettre puis le coups suivant le re re re.....
Lignes inutiles, temps rallongé..

@Staple : tu peux dormir en paix, mais tu avais bien compris que ma haine n'est que feinte, Par contre je porte Haut les couleurs du club "Des Un" 😀
 
Vote positif 0 Vote négatif
Pointage des X devenant des P

Staple1600 à dit:
Re

JBARBE
JCGL, camarchepas, Efgé et moi-même étions objectifs.
Et nos infos concernant VBA exactes.
La seule chose que tu peux ne pas apprécier (dans mon cas) est mon sens de l'humour.
Mais concernant ta boucle, il n'est pas utile de boucler sur 65536 lignes (sauf si tu utilises 65536 lignes)
C'est tout ce que nous tentions de te dire 😉
(Et c'est ce que l'on voit dans de nombreuses discussions où l'on parle de DerLig et où on utilise la syntaxe que nous évoquons)
Cliquez pour agrandir...

Détrompe toi j'apprécie l'humour de chacun d'ailleurs je suis sur ce forum en écoutant une radio de rire et de chansons !

Certes, je n'aurais jamais l'opportunité de saisir sur 65536 ( Rappel :maximum de lignes sur excel 2003 et avant ), mais comme la sortie de la macro est prévue avant avec un exit sub alors je ne vois pas le problème !

En tout cas, merci de vos réponses !
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Electron24
  • Résolu(e)
Microsoft 365 Virgules dans ListView
Réponses
5
Affichages
145
Electron24
Electron24
K
  • Résolu(e)
XL 2016 Affichage TextBox
Réponses
6
Affichages
243
KRUG WOO
K
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
479
CortoXls
C
P
  • Question Question
Microsoft 365 VBA et Segments TCD
Réponses
2
Affichages
201
patricko-13
P
A
  • Résolu(e)
XL 2019 Remplacer un mot et ajouter une couleur
Réponses
7
Affichages
337
Attila451
A
B
  • Question Question
Microsoft 365 Macro pour création fichier csv
Réponses
8
Affichages
466
job75
job75
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
177
kiki29
kiki29
F
  • Résolu(e)
Autres Insérer une ligne
2 3
Réponses
36
Affichages
2 K
francescofrancesco
F
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
108
patricktoulon
patricktoulon
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
916
laurent950
laurent950
W
  • Résolu(e)
XL 2016 Placer mes photos dans la colonne A, [A3], [A4],etc, jusqu'en [A99] selon le prénom et le nom colonnes B et C
2
Réponses
26
Affichages
407
Webperegrino
W
A
  • Question Question
XL 2019 Copie d'une valeur dans la cellule à côté d'une valeur trouvé
Réponses
1
Affichages
133
sylvanu
sylvanu
badraaliou4
  • Question Question
XL 2021 Importer les données Access dans Excel
Réponses
2
Affichages
432
badraaliou4
badraaliou4
C
  • Résolu(e)
XL 2016 MsgBox avec critères
2
Réponses
22
Affichages
596
candido57
C
M
  • Question Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
972
Mody200
M
J
  • Question Question
XL 2021 transfert listview vers feuille excel
Réponses
9
Affichages
313
Piment
P
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
643
Gestionnaire_rh
G
thunder23
  • Résolu(e)
XL 2021 And/Or dans If
Réponses
3
Affichages
328
thunder23
thunder23
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
339
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
C
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
CDALE
C
Retour