incrementation

[marie]

rebonjour

je cherche une methode vb pour incrementé une cellule a chaque changement de date dune autre cellule

voir piéce jointe

merci d'avance

 

[Michel_M]

Bonjour Marie
Ci joint proposition

A+
Michel

 

[Eric C]

Bonjour le forum
Bonjour Marie, bonjour Michel M

Plus le temps de mettre en place le code que déjà Michel est là. Pour une fois que j'avais la réponse. Pas mieux (même chose).
Bon week end à toutes & à tous
@ ++ Eric C

 

[marie]

Merci Michel

bon week end

 

[Michel_M]

Bonsoir Marie, Eric

Eric,

Quans j'ai vu que tu trainais dans le coin, j'ai speedé comme une bête !

Amicalement, bon WE à tous les 2

Michel

 

[marie]

Rebonsoir

jai un petit probleme cela marche quand je change la date manuellement
mais je renv a laide dune macro des date d'un autre tableau
la macro ce bloque

merci 'avance
Marie

 

[marie]

petite note sur la macro que j'utilise pour la mise a j

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