Archives Automatique sous conditions

[WDAndCo]

Bonsoir le Forum

Je voudrais qu'a chaque changement de valeur de certaines cellules que les nouvelles valeur saisies ce copie sur une feuille archive. Mais sans écraser la précédente. Elles doivent ce décaler vers la droite.

Avec le fichier joint c'est beaucoup plus claire, même moi j'ai compris ! !

D'avance merci.
Dominique

 

[Compte Supprimé 979]

Re : Archives Automatique sous conditions

Bonsoir mon cher WDandCo,

Tu trouveras ci-joint ton fichier modifié 😉

Lors de la saisie d'une date en H, la valeur vient se mettre sur la bonne ligne dans une nouvelle colonne sur la feuille "Archive"

A+

 

[WDAndCo]

Re : Archives Automatique sous conditions

Bonsoir le Forum et BrunoM45

Merci ce code fonctionne très bien. Est il possible de mettre en tête de colonne la date ou le fichier a été modifier, je sais que celle-ci seras écrasé a chaque nouvelle saisie jusqu'au moment ou toute la série auras été complété, mais cela ne me gêne pas. J'ai bien essayé de modifié le code mais sa bloque !
Merci de le peaufiner.

Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 2) <> "$H" Then Exit Sub
If Target.Value = "" Then Exit Sub
' Si on est dans la bonne colonne
Dim DerLig As Long, Lig As Long, DerCol As Integer
Dim Lieux As String, Postes As String, Zones As String, Aiguilles As String
Dim NewDate As String, DateSaisie As String
' Mise a jour des variables
Lieux = Range("A" & Target.Row)
Postes = Range("B" & Target.Row)
Zones = Range("C" & Target.Row)
Aiguilles = Range("D" & Target.Row)
NewDate = Range("H" & Target.Row)
DateSaisie = Range("J2")
' Recherche de la bonne ligne
With Sheets("Archive")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
For Lig = 2 To DerLig
If Range("A" & Lig) = Lieux And Range("B" & Lig) = Postes _
And Range("C" & Lig) = Zones And Range("D" & Lig) = Aiguilles Then
' La bonne ligne correspondante à été trouvée
Exit For
End If
Next Lig
' Inscrire la valeur dans la prochaine colonne vide
DerCol = .Cells(Lig - 1, Columns.Count).End(xlToLeft).Column
.Cells(Lig - 1, DerCol + 1).Value = NewDate
End With
Cells(1, DerCol + 1).Value = DateSaisie
End Sub

D'avance merci
Dominique

PS: L'ordre du classement de la feuille Archive est il important ?
Car suite a un classement par Lieux et Aiguilles la date ne ce mets plus a la bonne place ! Ou c'est a cause de la feuille Graissage qui ce classe aussi en fonction des futures dates d'interventions ?

 

[Compte Supprimé 979]

Re : Archives Automatique sous conditions

Salut WDandCo,

Pour le code tu y étais presque 😉
Tu as juste oublié le point devant Cell pour faire référence à l'objet conteneur "With Sheets("Archive")"
Et il faut intégrer la ligne dans With ... End With

Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 2) <> "$H" Then Exit Sub
If Target.Value = "" Then Exit Sub
' Si on est dans la bonne colonne
Dim DerLig As Long, Lig As Long, DerCol As Integer
Dim Lieux As String, Postes As String, Zones As String, Aiguilles As String
Dim NewDate As String, [B]DateSaisie As String[/B]
' Mise a jour des variables
Lieux = Range("A" & Target.Row)
Postes = Range("B" & Target.Row)
Zones = Range("C" & Target.Row)
Aiguilles = Range("D" & Target.Row)
NewDate = Range("H" & Target.Row)
[B]DateSaisie = Range("J2")[/B]
' Recherche de la bonne ligne
With Sheets("Archive")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
For Lig = 2 To DerLig
If Range("A" & Lig) = Lieux And Range("B" & Lig) = Postes _
And Range("C" & Lig) = Zones And Range("D" & Lig) = Aiguilles Then
' La bonne ligne correspondante à été trouvée
Exit For
End If
Next Lig
' Inscrire la valeur dans la prochaine colonne vide
DerCol = .Cells(Lig - 1, Columns.Count).End(xlToLeft).Column
.Cells(Lig - 1, DerCol + 1).Value = NewDate
[B][COLOR=#ff0000].[/COLOR][/B][COLOR=blue]Cells(1, DerCol + 1).Value = DateSaisie[/COLOR]
End With
End Sub

PS: L'ordre du classement de la feuille Archive est il important ?

Non, car si tu regardes bien le code, je parcours chaque ligne pour trouver celle qui correspond à la ligne de saisie.

Car suite a un classement par Lieux et Aiguilles la date ne ce mets plus a la bonne place !

Es-tu certain de bien prendre toutes les colonnes ensembles lors de ton tri !?

Ou c'est a cause de la feuille Graissage qui ce classe aussi en fonction des futures dates d'interventions ?

Rien à voir, ça ne pose pa de problème

A+

 

[BOISGONTIER]

Re : Archives Automatique sous conditions

Bonjour,

Archivage dans le commentaire de la cellule:

Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
  If Target.Column = 8 And Target.Count = 1 Then
    If Target.Value > [J2] Then
      MsgBox "Date invalide!"
      Application.Undo
    Else
      If Target.Comment Is Nothing Then Target.AddComment
         Target.Comment.Text Text:=Target.Comment.Text & _
         Target & " Le " & Now & vbLf
         Target.Comment.Shape.TextFrame.AutoSize = True
      End If
  End If
  Application.EnableEvents = True
End Sub

JB
Formation Excel VBA JB

 

[WDAndCo]

Re : Archives Automatique sous conditions

Bonjour le Forum, BrunoM45 et BOISGONTIER

Merci a vous deux, l'approche de BOISGONTIER est bien mais ne marche plus lorsque la feuille ce protege lors d'action des autres macros, mais le non remplissage de la feuille archive me gêne un peu, car dans le future j'aurais besoin de ces données. Autre chose, peut-être limité dans le commentaire les 5 dernières interventions et les mettent dans l'autre sens la plus récente en haut.

Pour la solution de BRUNOM45, elle me convient plus (Il est surement possible de combiner les 2) J'ai joint le fichier avec la feuille Archive triées
-> Toutes les cellules, Entête Oui, Tri 1 par Lieux, Tri 2 par Numéros d'aiguilles, OK

Après ce classement la date ne se mets plus a la bonne place ! J'ai l'impression quelle ce mets a la même ligne que dans la page Graissage (Mais omme dis plus haut la page Graissage ce protège a chaque nouvelle action de la macro SansFiltre)

Encore merci
Dominique

 

[Compte Supprimé 979]

Re : Archives Automatique sous conditions

Salut WDandCo,

Je suis sincèrement désolé 😱, je te parle de ne pas oublié le "point" dans mon précédent post,
et moi je l'oublie dans mon code 🙄

Voilà le bon code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 2) <> "$H" Then Exit Sub
If Target.Value = "" Then Exit Sub
' Si on est dans la bonne colonne
Dim DerLig As Long, Lig As Long, DerCol As Integer
Dim Lieux As String, Postes As String, Zones As String, Aiguilles As String
Dim NewDate As String, DateSaisie As String
' Mise a jour des variables
Lieux = Range("A" & Target.Row)
Postes = Range("B" & Target.Row)
Zones = Range("C" & Target.Row)
Aiguilles = Range("D" & Target.Row)
NewDate = Range("H" & Target.Row)
DateSaisie = Range("J2")
' Recherche de la bonne ligne
With Sheets("Archive")
  DerLig = .Range("A" & Rows.Count).End(xlUp).Row
  For Lig = 2 To DerLig
    If [B][COLOR=red].[/COLOR][/B]Range("A" & Lig) = Lieux And [COLOR=red][B].[/B][/COLOR]Range("B" & Lig) = Postes _
      And [B][COLOR=red].[/COLOR][/B]Range("C" & Lig) = Zones And [COLOR=red][B].[/B][/COLOR]Range("D" & Lig) = Aiguilles Then
      ' La bonne ligne correspondante à été trouvée
      Exit For
      End If
  Next Lig
  ' Inscrire la valeur dans la prochaine colonne vide
  DerCol = .Cells(Lig, Columns.Count).End(xlToLeft).Column
  .Cells(Lig, DerCol + 1).Value = NewDate
  .Cells(1, DerCol + 1).Value = DateSaisie
End With
End Sub

De plus lors de la sortie de la boucle For ... Next
La valeur de "Lig" est la bonne ligne, il n'est donc pas nécessaire de soustraire "1" à la ligne.

A+

 

[WDAndCo]

Re : Archives Automatique sous conditions

Re Bonjour

Pour le code tous fonction mais car il y a toujours un mais : La date ce mets dans la feuille Archive au format MM/JJ/AAAA alors que sur la feuille Graissage elle est au bon format JJ/MM/AAAA !
De plus un clique dans une cellule de la colonne H provoque l'archivage (Peut être un test du genre si NewDate=Cells(Lig, DerCol ) sorti sans archivage.
Votre avis.
J'ai remis le fichier, car le contrôle de validité de date ce fait après l'archivage, je ne sais pas si on peu l'inclure dans votre code ?

Amicalement
Dominique

 

[WDAndCo]

Re : Archives Automatique sous conditions

Je voudrais supprimer ce message.

 

[WDAndCo]

Re : Archives Automatique sous conditions

Bonjour le Forum

Pour faire suite a l'avant dernier post j'ai modifié le code de la façon suivante si F = H sorti, mais cela n'a pas l'air de marcher. Car F = H dans la feuille peut être mettre cette vérif après l'écriture sur la page Archives ou la le test serais SI Ligne/Colonne = Ligne/Colonne-1 Then Delete Ligne/Colonne votre avis.

Private Sub Worksheet_Change(ByVal Target As Range)
If Left(Target.Address, 2) <> "$H" Then Exit Sub
If Target.Value = "" Then Exit Sub
If Range("F" & Target.Row) = Target.Value Then Exit Sub
' Si on est dans la bonne colonne
Dim DerLig As Long, Lig As Long, DerCol As Integer
Dim Lieux As String, Postes As String, Zones As String, Aiguilles As String
Dim NewDate As String, DateSaisie As String
' Mise a jour des variables
Lieux = Range("A" & Target.Row)
Postes = Range("B" & Target.Row)
Zones = Range("C" & Target.Row)
Aiguilles = Range("D" & Target.Row)
NewDate = Range("H" & Target.Row)
DateSaisie = Range("J2")
' Recherche de la bonne ligne
With Sheets("Archive")
DerLig = .Range("A" & Rows.Count).End(xlUp).Row
For Lig = 2 To DerLig
If .Range("A" & Lig) = Lieux And .Range("B" & Lig) = Postes _
And .Range("C" & Lig) = Zones And .Range("D" & Lig) = Aiguilles Then
' La bonne ligne correspondante à été trouvée
Exit For
End If
Next Lig
' Inscrire la valeur dans la prochaine colonne vide
DerCol = .Cells(Lig, Columns.Count).End(xlToLeft).Column
.Cells(Lig, DerCol + 1).Value = NewDate
.Cells(1, DerCol + 1).Value = "Saisie le" & Chr(10) & DateSaisie
End With
End Sub

D'avance merci
Dominique

PS : Pour le Format de la Date s'est bon ! (Pas tous compris.)

 

[WDAndCo]

Re : Archives Automatique sous conditions

Bonsoir le Forum

Je n'ai toujours pas trouvé la solution pour empêcher l'écriture sur la page Archive lorsque on fait juste un clique dans la colonne H de la feuille Graissage. Je joins la dernière Version du classeur merci d'avance de me transmettre vos remarques ou solutions.

Dominique