Pointage des X devenant des P ( RESOLU )

JBARBE · 8 Juin 2014

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 !

JCGL · 8 Juin 2014

Re : Pointage des X devenant des P

Bonjour à tous,

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

For I = 5 To 65536

par

For I = 5 To Range("B65536").End(xlUp).Row

A+ à tous

JBARBE · 9 Juin 2014

Re : Pointage des X devenant des P

JCGL à dit:
Bonjour à tous,

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

par

A+ à tous

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 !

camarchepas · 9 Juin 2014

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

JCGL · 9 Juin 2014

Re : Pointage des X devenant des P

Bonjour à tous,

JBARBE à dit:
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 !

Et moi je pense qu'il est plus rapide de travailler sur 100 lignes que sur 65000...

A+ à tous

Staple1600 · 9 Juin 2014

Re : Pointage des X devenant des P

Bonjour à tous

camarchepas pense comme JCGL, et je pense qu'ils ont raison de penser ce qu'ils pensent 😉

JBARBE, nous sommes trois à penser dans la même direction, qu'en conclues-tu ?

camarchepas · 9 Juin 2014

Re : Pointage des X devenant des P

Re à tous ,

Dans ce cas , même si la solution n'est pas propre, l'on pourrait plutot employer: exit for

pour sortir proprement de la boucle....

Staple1600 · 9 Juin 2014

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 😉

Efgé · 9 Juin 2014

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

Staple1600 · 9 Juin 2014

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)

JBARBE · 9 Juin 2014

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 !

JBARBE · 9 Juin 2014

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

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 !

Staple1600 · 9 Juin 2014

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)

Efgé · 9 Juin 2014

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 !!

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" 😀

JBARBE · 9 Juin 2014

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)

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 !

Pointage des X devenant des P ( RESOLU )

JBARBE

XLDnaute Barbatruc

Pièces jointes

JCGL

XLDnaute Barbatruc

JBARBE

XLDnaute Barbatruc

camarchepas

XLDnaute Barbatruc

JCGL

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

camarchepas

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

JBARBE

XLDnaute Barbatruc

Pièces jointes

JBARBE

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

JBARBE

XLDnaute Barbatruc

Discussions similaires

Pointage des X devenant des P ( RESOLU )

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency