Enregistrer Historique d'une Cellule de gauche à droite

[Azimade]

Bonjour Mesdames & Messieurs les As de la programmation,

J'ai besoin d'aide pour modifier mon fichier afin qu'il conserve l'historique
des dates que je rentre dans la colonne ou se trouve toutes les cellules grises " Travaux effectués le: "

Les dates de cette colonne sont entrées à chaque fois qu'un travail est réalisé.
On entre la date et des qu'on appuie sur "Entrer", on doit avoir un enregistrement de cette date dans une autre feuille " Historique Planification" et sur la même ligne. la prochaine date entrée dans la même cellule, devra être enregistrée à droite du précédent enregistrement.
Je souhaite faire un enregistrement horizontal au lieu de vertical comme tout ce que j'ai pu lire dans le forum.
Je vous joins un fichier pour concrétiser mes dires.
Merci à tous d'avance...
Cordialement Nicolas

 

[Jacky67]

Bonjour Mesdames & Messieurs les As de la programmation,

J'ai besoin d'aide pour modifier mon fichier afin qu'il conserve l'historique
des dates que je rentre dans la colonne ou se trouve toutes les cellules grises " Travaux effectués le: "

Les dates de cette colonne sont entrées à chaque fois qu'un travail est réalisé.
On entre la date et des qu'on appuie sur "Entrer", on doit avoir un enregistrement de cette date dans une autre feuille " Historique Planification" et sur la même ligne. la prochaine date entrée dans la même cellule, devra être enregistrée à droite du précédent enregistrement.
Je souhaite faire un enregistrement horizontal au lieu de vertical comme tout ce que j'ai pu lire dans le forum.
Je vous joins un fichier pour concrétiser mes dires.
Merci à tous d'avance...
Cordialement Nicolas

Bonjour,
Ceci, placé dans le module de la feuille "PLANIFICATION" devrait faire

Dim Tmp As String 'a placer tout en haut du module
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("j8:j" & Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then Exit Sub
    If Target.Value <> Tmp Then
        Feuil16.Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = Target.Value
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("j8:j" & Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then
        Tmp = Target.Value
    End If
End Sub

 

[Azimade]

Un grand Merci à vous, Mr Jacky67 !!!...
Ca fonctionne tres bien.
Pouvez vous me mettre un commentaire sous chaque ligne pour que je puisse comprendre le deroulement de votre programme ?
Ou avez vous appris le langage Vba ?
Connaissez vous une source papier ou CD sur laquelle je pourrai m'appuyer pour debutant ou intermediaire ?
J'ai deja acheté plusieurs livres pour apprendre: Vab Excel 2013 de ITmax
Vba Excel 2016 de Michel Amelot etEcel 2013 programmation Vba de Eyrolles.
il y a les bases, mais ca se complique tres vite.
Encore Merci...
Nous nous sommes loupé de peu, hier soir, à 5 minutes prêt.
Au plaisir de vous croiser sur le forum...
Cordialement
Nicolas

 

[Jacky67]

Un grand Merci à vous, Mr Jacky67 !!!...
Ca fonctionne tres bien.
Pouvez vous me mettre un commentaire sous chaque ligne pour que je puisse comprendre le deroulement de votre programme ?
Ou avez vous appris le langage Vba ?
Connaissez vous une source papier ou CD sur laquelle je pourrai m'appuyer pour debutant ou intermediaire ?
J'ai deja acheté plusieurs livres pour apprendre: Vab Excel 2013 de ITmax
Vba Excel 2016 de Michel Amelot etEcel 2013 programmation Vba de Eyrolles.
il y a les bases, mais ca se complique tres vite.
Encore Merci...
Nous nous sommes loupé de peu, hier soir, à 5 minutes prêt.
Au plaisir de vous croiser sur le forum...
Cordialement
Nicolas

Re..
Les commentaires;

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub 'On sort du code si la selection et plus grande que une case
  'Ci-dessous on controle que la selection en cours est bien située dans la plage, sinon on éjecte de la macro
  If Intersect(Target, Range("j8:j" & Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then Exit Sub
  If Target.Value <> Tmp Then ' on controle que la cellule à bien était modifié, pour éviter (en partie) les doublons de date
  'Puis on cherche la position de la dernière cellule occupée dans la même ligne que la selection,
  'mais dans la Feuil16(codeName de la feuille'PLANIFICATION'),
  'et on l'incrémente de 1 vers la droite avec "offset(,1)"
  'puis on lui attribue la valeur de la cellule en cours "=Target.value"
  Feuil16.Cells(Target.Row, Columns.Count).End(xlToLeft).Offset(, 1) = Target.Value
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub 'On sort du code si la selection et plus grande que une case
  'Ci-dessous on controle que la selection en cours est bien située dans la plage, dans ce CAS ce sera
  'A partir de J8, jusqu'a Jx, x étant la dernière ligne occupée en colonne G
  If Not Intersect(Target, Range("j8:j" & Cells(Rows.Count, "G").End(xlUp).Row)) Is Nothing Then
  Tmp = Target.Value ' puis on mémorise dans la variable Tmp la cellule selectionnée
  End If
End Sub

Pour la lecture, je dirais, que tout est bon à prendre, l'essentiel étant les tests, puis les tests et encore les tests, et si vraiment on ne trouve pas de solution, les forums.
C'est tout de même rare, qu'ici (entre autres) qu'aucune solution ne soit trouvée quelque soit la problématique.
Ce qui manque le plus souvent, c'est le temps... et, il n'est ni compressible ni expansible.

Bon courage
JJ