Historique de dates de réalisation d'une opération

Le 19/05/2016 à 14:27

Bonjour le forum!

Je vous sollicite aujourd'hui pour de l'aide sur une macro que je n'arrive pas à formaliser.

A chaque opération je renseigne une date de réalisation (feuille Secteur 1, colonne E). J'aimerai que cette date soit copiée dans la feuille "Suivi", dans la cellule B2 par exemple.

Si l'on change la date dans la feuille Secteur 1 (parce que l'on a réalisé l'opération 1 mois après par exemple), j'aimerai que cette date s'ajoute à la suite de la première, en cellule B3.

je précise qu'il y a une macro qui m'affiche à l'écran le mois sélectionné en E5.

Une âme charitable pour m'aider?

15planning.xlsm (52.14 Ko)
Le 19/05/2016 à 14:40

Bonjour et désolé !

Si tu commençais par épurer tes macros, supprimer 2 modules... pour ma part je pourrais peut-être commencer à lire...

Mais des dizaines de lignes de scrollage !!! Ce n'est même plus de l'enregistrement ordinaire , déjà assez pénible à regarder...

Cordialement.

Le 19/05/2016 à 14:46

Bonjour Mferrand,

Désolé! J'ai épuré les lignes de scrollage, j'espère que c'est un peu mieux...

6planning.xlsm (51.84 Ko)
Le 19/05/2016 à 15:05

Ça ne s'invente pas !

Sub CLEAR()
Application.ScreenUpdating = False
If MsgBox("Êtes-vous certain de vouloir supprimer les opérations dans chaque onglet?", vbYesNo, "Demande de confirmation") = vbYes Then
  Sheets("LH LA").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 341
    ActiveWindow.ScrollColumn = 331
    ActiveWindow.ScrollColumn = 273
    ActiveWindow.ScrollColumn = 246
    ActiveWindow.ScrollColumn = 171
    ActiveWindow.ScrollColumn = 62
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 727
    ActiveWindow.ScrollRow = 681
    ActiveWindow.ScrollRow = 590
    ActiveWindow.ScrollRow = 557
    ActiveWindow.ScrollRow = 426
    ActiveWindow.ScrollRow = 225
    ActiveWindow.ScrollRow = 143
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("TTS CATA").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 342
    ActiveWindow.ScrollColumn = 337
    ActiveWindow.ScrollColumn = 320
    ActiveWindow.ScrollColumn = 229
    ActiveWindow.ScrollColumn = 74
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 499
    ActiveWindow.ScrollRow = 492
    ActiveWindow.ScrollRow = 472
    ActiveWindow.ScrollRow = 359
    ActiveWindow.ScrollRow = 230
    ActiveWindow.ScrollRow = 173
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("MASTIC").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollColumn = 352
    ActiveWindow.ScrollColumn = 306
    ActiveWindow.ScrollColumn = 112
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 7
    Range("A1:B1").Select
    Sheets("APPRETS").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 363
    ActiveWindow.ScrollColumn = 314
    ActiveWindow.ScrollColumn = 140
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 118
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 77
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("LAQUES").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 359
    ActiveWindow.ScrollColumn = 319
    ActiveWindow.ScrollColumn = 208
    ActiveWindow.ScrollColumn = 92
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 280
    ActiveWindow.ScrollRow = 279
    ActiveWindow.ScrollRow = 275
    ActiveWindow.ScrollRow = 246
    ActiveWindow.ScrollRow = 242
    ActiveWindow.ScrollRow = 211
    ActiveWindow.ScrollRow = 206
    ActiveWindow.ScrollRow = 169
    ActiveWindow.ScrollRow = 156
    ActiveWindow.ScrollRow = 141
    ActiveWindow.ScrollRow = 129
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 123
    ActiveWindow.ScrollRow = 122
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("FINITIONS").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 362
    ActiveWindow.ScrollColumn = 357
    ActiveWindow.ScrollColumn = 316
    ActiveWindow.ScrollColumn = 78
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 85
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("CIRE").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 351
    ActiveWindow.ScrollColumn = 348
    ActiveWindow.ScrollColumn = 346
    ActiveWindow.ScrollColumn = 306
    ActiveWindow.ScrollColumn = 86
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 76
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    Range("A1:B1").Select
    Sheets("DILUTION").Select
    Range("h9:ni769").Select
    Selection.ClearContents
    ActiveWindow.ScrollColumn = 356
    ActiveWindow.ScrollColumn = 351
    ActiveWindow.ScrollColumn = 326
    ActiveWindow.ScrollColumn = 133
    Range("A1:B1").Select
    Sheets("Légende").Select
    ActiveWindow.SmallScroll Down:=-9
    MsgBox "Les opérations ont été effacées!"
    End If

End Sub

Il ne suffit pas de mettre des noms en anglais pour rendre les procédures plus rationnelles ou plus performantes...

La même, écrite en VBA :

Sub CLEAR()
    Dim wws, i%
    wws = Array("LH LA", "TTS CATA", "MASTIC", "APPRETS", "LAQUES", "FINITIONS", _
     "CIRE", "DILUTION")
    If MsgBox("Êtes-vous certain de vouloir supprimer les opérations dans chaque onglet?", _
     vbYesNo, "Demande de confirmation") = vbYes Then
        Application.ScreenUpdating = False
        For i = 0 To UBound(wws)
            Worksheets(wws(i)).Range("H9:NI769").ClearContents
        Next i
        Application.ScreenUpdating = True
        MsgBox "Les opérations ont été effacées!"
    End If
End Sub

Tu auras déjà gagné ça !

Le 19/05/2016 à 15:10

Hahah oups...

6planning-1.xlsm (44.44 Ko)
Le 19/05/2016 à 15:18

bonjour,

Pour faire simple je n'ai pas appliqué le code de mon amiFerrand... mais j'ai quand même fait un peu de ménage !

A+

11planningmaximed-vg.xlsm (50.22 Ko)
Le 19/05/2016 à 15:27

Galopin !

Je vais en profiter pour prendre une douche !

Le 19/05/2016 à 15:34

Merci MFerran je n'avais pas vu ta réponse!

Bonjour Galopin,

C'est exactement ça merci ! Et si je veux que les dates s'ajoutent à la suite de façon horizontale, comment on fait? (B2, C2... comme indiqué dans le fichier)

Merci d'avance,

10planningmaximed-vg-1.xlsm (50.55 Ko)
Le 19/05/2016 à 16:37

bonsoir,

Macro à remplacer :

Private Sub Suivi(Des$, MaDate As Date)
Dim i%, ii%, a(), j%, Y  As Boolean
   With Worksheets("Suivi")
      i = .Cells(.Rows.Count, 1).End(xlUp).Row
      a = .Range(.Cells(1, 1), .Cells(i, 1)).Value
      For ii = 2 To i
         If .Cells(ii, 1) = Des Then
            j = .Cells(ii, 1).End(xlToRight).Column + 1
            .Cells(ii, j) = MaDate
            Y = True
            Exit For
         End If
      Next
      If Not Y Then
         .Cells(ii, 1) = Des
         .Cells(ii, 2) = MaDate
      End If
   End With
End Sub

A+

Le 19/05/2016 à 18:15

Super merci!

Rechercher des sujets similaires à "historique dates realisation operation"