re compteur

[CAROLE]

Bonjour le forum

je recherche toujours une methode a mon probléme
d'incrémentation quand changement de date

voir piéce jointe


merci de votre aide

Carole

 

[Gérard DEZAMIS]

Bonjour carole
En E6 tu mets 1
En E7 tu mets : =SI(ET(ESTNUM(A7);A6=A7);"";MAX($E$6:E6)+1) et tu "tires" cette formule vers le bas

Normalement ... (doigts croisés pour conjurer le mauvais sort) cela devrait convenir à la résolution de ton problème
J'en ai assez de te voir jouer les ventilateurs !
@+
GD

 

[CAROLE]

Merci Gerard
mais s pas le résultat que je cherche lol

Quand la date change en A6
mettre un incrément E6

Pour savoir le nombre de fois que la date change
idem pour les autres ligne
oupppss voila revoir la piéce jointe

salut merci pour ta réponse

carole

 

[jmps]

Bonjour Carole, Gérard,

Si je puis me permettre de m'immiscer dans votre fil.
Carole, tu dis que la date est mise à jour par une macro. Pourquoi n'incrémentes-tu pas ton compteur au moment où tu changes cette date ?

Range("E6").Value = Range("E6").Value + 1

Ou alors je ne comprends pas ta question.

A+

José

 

[CAROLE]

Voila la macro de mise a jour
Sub Maj()


Range("B11:G35").Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

Dim Cpt As Byte
Dim NbrLigSrc As Byte
Dim LigDepSrc As Byte
Dim NbrLigDst As Byte
Dim LigDepDst As Byte
Dim Trouve As Boolean
Dim ShSrc As Worksheet
Dim ShDst As Worksheet
Dim Recherche
Dim Premier As String


Set ShSrc = Sheets("Feuil1")
Set ShDst = Sheets("CLASSEUR")

LigDepSrc = 11
NbrLigSrc = ShSrc.Range("B36").End(xlUp).Row
If NbrLigSrc >= 11 Then
LigDepDst = 5
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row

For Cpt = LigDepSrc To NbrLigSrc
Trouve = False
With ShDst.Range("B" & LigDepDst & ":B" & NbrLigDst)
Set Recherche = .Find(What:=ShSrc.Range("B" & Cpt))
If Not Recherche Is Nothing Then
Premier = Recherche.Address
Do
If ShDst.Range("C" & Recherche.Row) = ShSrc.Range("C" & Cpt) Then
If ShDst.Range("D" & Recherche.Row) = ShSrc.Range("D" & Cpt) Then

ShDst.Range("A" & Recherche.Row) = Date
ShDst.Range("G" & Recherche.Row) = ShDst.Range("G" & Recherche.Row) + ShSrc.Range("G" & Cpt)
ShDst.Range("H" & Recherche.Row) = ShDst.Range("H" & Recherche.Row) + 1
Trouve = True
Exit Do
End If
End If


Set Recherche = .FindNext(Recherche)
Loop While Not Recherche Is Nothing And Recherche.Address <> Premier
End If
If Trouve = False Then
ShDst.Range("A" & NbrLigDst + 1) = Date
ShDst.Range("B" & NbrLigDst + 1) = ShSrc.Range("B" & Cpt)
ShDst.Range("C" & NbrLigDst + 1) = ShSrc.Range("C" & Cpt)
ShDst.Range("D" & NbrLigDst + 1) = ShSrc.Range("D" & Cpt)

ShDst.Range("G" & NbrLigDst + 1) = ShSrc.Range("G" & Cpt)
ShDst.Range("H" & NbrLigDst + 1) = 1
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
End If
End With
Next
End If
End Sub

 

[jmps]

Alors comme ça, vite fait sans tester :

Set Recherche = .FindNext(Recherche)
Loop While Not Recherche Is Nothing And Recherche.Address <> Premier
End If
If Trouve = False Then
ShDst.Range("A" & NbrLigDst + 1) = Date
ShDst.Range("E" & NbrLigDst + 1) = ShDst.Range("E" & NbrLigDst + 1) + 1
ShDst.Range("B" & NbrLigDst + 1) = ShSrc.Range("B" & Cpt)
ShDst.Range("C" & NbrLigDst + 1) = ShSrc.Range("C" & Cpt)
ShDst.Range("D" & NbrLigDst + 1) = ShSrc.Range("D" & Cpt)

ShDst.Range("G" & NbrLigDst + 1) = ShSrc.Range("G" & Cpt)
ShDst.Range("H" & NbrLigDst + 1) = 1
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
End If
End With
Next
End If
End Sub

Pas le temps de voir plus avant, il faut que je parte. Mais si c'est pas ça, tu me dis et je regarderai ce soir si je peux.

A+

José

 

[CAROLE]

Bonsoir José

merci pour ton aide

ça marche pas j"ai bien la valeur 1 dans E mais quand la date change en A le compteur e reste a 1 il ne s'incremente pas

merci de ton aide je reste en ligne

carole

 

[jmps]

Bonjour Carole,

J'essaie toujours de décortiquer ta macro mais il me manque la feuille "Feuil1" qui est la feuille source de tes données dans ton fichier exemple.
Peux-tu reposter ton fichier avec les deux feuilles "Classeur" et "Feuil1" ?

En fait ta macro ne trouve jamais les données ce qui fait qu'au lieu d'incrémenter le compteur elle ajoute des lignes. Je pense qu'il manque un Else au If Trouve = False. Mais il me faudrait ton fichier complet, du moins avec tous les onglets.

A+

José

 

[CAROLE]

Bonjour josé

merci pour ton aide
je te donne le fichier en piéce jointe

merci bonne journée

carole

 

[CAROLE]

Je te donne cette piéce jointe avec modif

merci

 

[jmps]

Re Carole,

Mieux vaut tard que jamais. Voilà, ça a l'air de fonctionner. Les lignes que j'ai ajouté sont en gras.

Dans le Sub Maj() :

...
If Trouve = False Then
&nbsp;&nbsp;&nbsp;ShDst.Range("A" & NbrLigDst + 1) = Date
&nbsp;&nbsp;&nbsp;ShDst.Range("B" & NbrLigDst + 1) = ShSrc.Range("B" & Cpt)
&nbsp;&nbsp;&nbsp;ShDst.Range("C" & NbrLigDst + 1) = ShSrc.Range("C" & Cpt)
&nbsp;&nbsp;&nbsp;ShDst.Range("D" & NbrLigDst + 1) = ShSrc.Range("D" & Cpt)
&nbsp;&nbsp;&nbsp;ShDst.Range("G" & NbrLigDst + 1) = ShSrc.Range("G" & Cpt)
&nbsp;&nbsp;&nbsp;ShDst.Range("H" & NbrLigDst + 1) = 1
&nbsp;&nbsp;&nbsp;NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
Else
&nbsp;&nbsp;&nbsp;ShDst.Range("E" & Recherche.Row).Value = ShDst.Range("E" & Recherche.Row).Value + 1
End If
...

J'espère que cette fois est la bonne. N'hésite pas sinon...

Bonne fin d'après-midi.

José

 

[CAROLE]

OUPSS
me revoila
ça me donne pas ce que je recherche lol

ce que je recherche s incremente E uniquement quand la date en A change

A savoir que je p avoir plusieurs mises a jours la même journée
pour un même nom donc avec la même date qui ce valide dans A

Je Cherche a avoir un increment uniquement quand la date change

ex 10/09/2004 11/09/2004 Increment dans E
SI ex 10/09/2004 10/09/2004 PAS d'increment dans E


pas trop facile lol
bonne soirée
carole

 

[jmps]

Re-re Carole,

Ah les femmes ! Jamais satisfaites Lol ! ;°)

Okay, voilà ton Sub Maj() avec les modifs en gras.

Sub Maj()

Range("B11:G35").Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

Dim Cpt As Byte
Dim NbrLigSrc As Byte
Dim LigDepSrc As Byte
Dim NbrLigDst As Byte
Dim LigDepDst As Byte
Dim Trouve As Boolean
Dim ShSrc As Worksheet
Dim ShDst As Worksheet
Dim Recherche
Dim Premier As String


Set ShSrc = Sheets("Feuil1")
Set ShDst = Sheets("CLASSEUR")

LigDepSrc = 11
NbrLigSrc = ShSrc.Range("B36").End(xlUp).Row
If NbrLigSrc >= 11 Then
LigDepDst = 5
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row

For Cpt = LigDepSrc To NbrLigSrc
Trouve = False
With ShDst.Range("B" & LigDepDst & ":B" & NbrLigDst)
Set Recherche = .Find(What:=ShSrc.Range("B" & Cpt))
If Not Recherche Is Nothing Then
Premier = Recherche.Address
Do
If ShDst.Range("C" & Recherche.Row) = ShSrc.Range("C" & Cpt) Then
If ShDst.Range("D" & Recherche.Row) = ShSrc.Range("D" & Cpt) Then
DatePrec = ShDst.Range("A" & Recherche.Row)
ShDst.Range("A" & Recherche.Row) = Date
ShDst.Range("G" & Recherche.Row) = ShDst.Range("G" & Recherche.Row) + ShSrc.Range("G" & Cpt)
ShDst.Range("H" & Recherche.Row) = ShDst.Range("H" & Recherche.Row) + 1
Trouve = True
Exit Do
End If
End If


Set Recherche = .FindNext(Recherche)
Loop While Not Recherche Is Nothing And Recherche.Address <> Premier
End If
If Trouve = False Then
ShDst.Range("A" & NbrLigDst + 1) = Date
ShDst.Range("B" & NbrLigDst + 1) = ShSrc.Range("B" & Cpt)
ShDst.Range("C" & NbrLigDst + 1) = ShSrc.Range("C" & Cpt)
ShDst.Range("D" & NbrLigDst + 1) = ShSrc.Range("D" & Cpt)

ShDst.Range("G" & NbrLigDst + 1) = ShSrc.Range("G" & Cpt)
ShDst.Range("H" & NbrLigDst + 1) = 1
NbrLigDst = ShDst.Range("A65536").End(xlUp).Row
Else
If DatePrec <> Date Then
ShDst.Range("E" & Recherche.Row).Value = ShDst.Range("E" & Recherche.Row).Value + 1
End If
End If
End With
Next
End If
End Sub

En fait, je stocke la date précédente dans DatePrec avant de modifier la colonne A. Et ensuite je teste par rapport à la date du jour car, si j'ai bien compris, tu remplaces l'ancienne par la date actuelle. C'est bien ça ?
Si c'est toujours pas bon, tu sais où me trouver. Lol !

Bonne soirée.

José

 

[CAROLE]

Merci José


ça marche super bien
bravo a toi
mille merci bonne soirée

carole

bis

 

[jmps]

Ouf !

Bonne soirée. A une prochaine...

José