Microsoft 365 Archivage et Récupération données

eric72 · 11 Juillet 2023

Bonsoir à tous,
Tout d'abord à TooFatBoy pour avoir solutionné un de mes problème, cependant il m'en reste un...
Lorsque je remplis mon planning pour une semaine choisie j'archive ces données dans l'onglet "Archives", par contre quand je rappelle cette semaine, le temps de traitement est long pour récupérer les données.
Vous avez peut-être un code "allégé" pour effectuer cette récupération (je galère)!!!
Merci à tous pour votre aide (comme d'habitude).
Eric

TooFatBoy · 12 Juillet 2023

Gégé-45550 à dit:
Vous pourriez peut-être aussi faire un fichier "modèle" sur 1 an et l'utiliser pour créer une nouvelle archive chaque année.

J'allais dire pareil, mais avec une feuille par année au lieu d'un fichier par année.

Et du coup j'allais demander la quantité maximale d'informations à mémoriser par année.

eric72 · 17 Juillet 2023

Gégé-45550 à dit:
Bonjour,
de la part de TooFatBoy, la procédure à suivre pour réparer le fichier:

Le fichier réparé est en attache.
Cordialement,

Bonjour Gégé-45550,
Merci beaucoup pour le boulot réalisé, en effet plus de feuille Fantôme.
Décidémment vous êtes tous géniaux.

TooFatBoy · 17 Juillet 2023

eric72 à dit:
Merci et tu sais 10 ans c'est déjà énorme

Certes, mais 10 ans d'Amour ça paraît 10 secondes.

TooFatBoy · 17 Juillet 2023

eric72 à dit:
J'ai commencé par ta proposition, temps de réponse 1,7 sec au lieu de 4,5 seconde

C'est bizarre, sur mon PC qui a 15 ans ça me semble moins long que ça.

Et quand tu cliques sur le bouton pour effacer, ça prend combien de temps ?
20 secondes ? 30 secondes ?

J'ai modifié la macro pour effacer, mais comme chez moi ça devient beaucoup plus long que la macro d'origine, je l'ai laissée.

eric72 · 17 Juillet 2023

Tout est parfait, toutefois j'ai une dernière petite requête, pour alléger mon fichier, j'aimerais qu'à l'ouverture dans "Archives" il mes supprime les dates inférieures à aujourd'hui moins 1 an et qu'il me rajoute automatiquement des dates jusqu'à aujourd'hui + 6 mois, j'ai donc mis ce code
Private Sub Workbook_Open()
'Sheets("Planning").Activate
'ActiveWindow.Zoom = 145
Sheets("Archives").Visible = True
With Sheets("Archives")
For j = 30 To 1 Step -1 'disons les 30 premières colonnes
If .Cells(1, j).Value < Date - 365 Then
Columns(j).Delete
End If
Next

Dim PCV As Range 'déclare la variable PCV (Première Cellule Vide)
Set PCV = Cells(1, Application.Columns.Count).End(xlToLeft).Offset(0, 1) 'adresse de la 1ère cellule vide de la ligne 1
dd = Sheets("Archives").Cells(1, Columns.Count).End(xlToLeft).Value 'derniere date existante
mydate = DateAdd("m", 6, Date) 'dernière date + 6 mois
For Each c In Worksheets("Archives").Range("TB1:UE1").Cells
If c.Value < mydate Then
PCV = dd + 1
End If

Next

Sheets("Archives").Visible = False
End With
End Sub

La 1ère partie fonctionne très bien, las dates sont bien supprimées mais pour l'ajout il m'ajoute qu'une seule date même si je l'ouvre le 17/07 et que la dernière fois il a été ouvert le 13/07 (toujours à cause des 10 ans de mariage)
Je ne sais pas si je suis bien clair!!!

eric72 · 17 Juillet 2023

ChTi160 à dit:
Bonjour le Fil
Pourrais-tu mettre des exemples de ce que tu peux avoir de plus complet comme Infos dans ta feuille "Archive"
Demande a quoi correspond la Rubrique "date rdv Prévue" dans ta feuille Planning ?
à quoi servent les trois Lignes vides au-dessus de "date rdv Prévue" ?
Merci par avance
Bonne Journée
Jean marie

Bonjour ChTi60,
Tout d'abord merci beaucoup d'avoir jeté un coup d'oeil à mes problèmes, pour répondre à tes questions:
- Pourquoi cette disposition c'est uniquement pour garder la mise en page initiale et donc ne pas perturber l'utilisatrice
- Les trois lignes vides correspondent au détail de la commande lorsqu'on sélectionne un client, le détail s'inscrit dans ces lignes.
- Pour la date de rendez-vous prévue, c'est lorsqu'un commercial s'est engagée par avance sur une date de pose, du coup la personne du planning est au courant ce qui lui permet de respecter cette date.

TooFatBoy · 17 Juillet 2023

Tu devrais poster ton fichier pour être sûrs qu'on travaille tous sur le même fichier.
Là j'ai l'impression que ce n'est pas le fichier de #25 car, si je me souviens bien, les dates ne sont pas sur la première ligne dans ce fichier.

eric72 · 17 Juillet 2023

TooFatBoy à dit:
Tu devrais poster ton fichier pour être sûrs qu'on travaille tous sur le même fichier.
Là j'ai l'impression que ce n'est pas le fichier de #25 car, si je me souviens bien, les dates ne sont pas sur la première ligne dans ce fichier.

En effet, je remets donc le fichier, dans l'idéal j'aimerais garder les archives 1 année et pouvoir programmer mon planning 6 mois à l'avance, exemple au 17/07/2023 les archives vont du 17/07/2022 au 17/01/2024 automatiquement à l'ouverture même si ça fait 1 mois que je ne l'ai pas ouvert.
Merci beaucoup

eric72 · 17 Juillet 2023

oulala ça n'est pas le bon fichier, 1000 excuses

TooFatBoy · 17 Juillet 2023

eric72 à dit:
oulala ça n'est pas le bon fichier, 1000 excuses

Tu as la possibilité d'éditer tes messages pour y modifier le texte ou ajouter/supprimer/changer les pièces jointes.

ChTi160 · 17 Juillet 2023

Bonjour
J'ai supprimé ce que j'avais proposé Lol
Car je me pose des questions quant au rendu des macros lorsque l'on ouvre le Classeur plusieurs fois
donc aujourd'hui on aura
'17/07/2023 les archives vont du 17/07/2022 au 17/01/2024
et quoi demain ? Lol
18/07/2023 les archives vont du 17/07/2022 au 18/01/2024
Jean marie

eric72 · 17 Juillet 2023

Re Bonjour Jean-Marie

ChTi160 à dit:

Bonjour le Fil
Date Moins 365 ça donne ce qui est avant le 17/07/2022 dans ta base de Données on en est Au "26/12/2022" Long
Sinon ce que j'ai fait ( perfectible )

VB:

Sub Delete()
Dim Col As Long
Application.ScreenUpdating = False
With Sheets("Archives")
  For Col = 30 To 3 Step -1
  If .Cells(2, Col).Value < Date - 365 Then
    .Cells(1, Col).EntireColumn.Delete
  End If
  Next
End With
Application.ScreenUpdating = True
End Sub

Sub AddDate()
Dim Firstday As Long
Dim LastDay As Long
Dim I As Long
Dim Dte As Long
Application.ScreenUpdating = False
With Sheets("Archives")
LastDate = .Cells(2, .Columns.Count).End(xlToLeft).Value
Firstday = LastDate + 1
  LastDay = VBA.DateAdd("m", 6, LastDate)
    For Dte = Firstday To LastDay
      .Cells(2, .Columns.Count).End(xlToLeft).Offset(, 1) =  CDate(Dte)
    Next Dte
End With
Application.ScreenUpdating = True
End Sub

A voir donc
Jean marie

Je pense qu'il y a un petit problème avec AddDate!!! les dates s'ajoutent jusqu'au 14/07/2024 au lieu de 17/01/2024
Dans l'idéal il faudrait si possible du 17/07/2022 au 17/01/2024
Merci beaucoup

ChTi160 · 17 Juillet 2023

Re
Regarde mon message #40
Jean marie

eric72 · 17 Juillet 2023

ChTi160 à dit:
Re
Regarde mon message #40
Jean marie

Oui en effet à chaque ouverture ça serait bien d'avoir :
- Date de début = aujourd'hui - 1 an
- Date de fin = aujourd'hui + 6 mois
Merci beaucoup

ChTi160 · 17 Juillet 2023

Ce qui revient chaque jours a supprimer une colonne et a ajouter une colonne en bout de BDD !
Pour ne pas supprimer des colonnes (dates futures) qui seraient déjà complétées...
L'idéal serait de partir d'une feuille "Archives" qui respecte cette règle

- Date de début = aujourd'hui - 1 an
- Date de fin = aujourd'hui + 6 mois

et ensuite ne supprimer et n'ajouter qu'une colonne une fois par jour .
Jean marie

eric72 · 17 Juillet 2023

ChTi160 à dit:
Ce qui revient chaque jours a supprimer une colonne et a ajouter une colonne en bout de BDD !
Pour ne pas supprimer des colonnes (dates futures) qui seraient déjà complétées...
Jean marie

Exactement sauf que si l'utilisateur ne l'ouvre pas pour cause d'absence, de congés ou week-end prolongé il se peut qu'il y ait plusieurs jours à ajouter

Microsoft 365 Archivage et Récupération données

eric72

XLDnaute Accro

Pièces jointes

TooFatBoy

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

eric72

XLDnaute Accro

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

eric72

XLDnaute Accro

Pièces jointes

eric72

XLDnaute Accro

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

eric72

XLDnaute Accro

Pièces jointes

ChTi160

XLDnaute Barbatruc

eric72

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

eric72

XLDnaute Accro

Discussions similaires