XL 2013 Message d'attente

[Luc MOUNY]

Bonsoir ou bonjour à tous

Me revoilà (encore),

J'ai fait un programme de gestion d'une association qui comporte 2500 adhérents environ. Le programme comporte un enchainement de 7 macros,qui fonctionnent parfaitement, mais j'ai un temps de traitement qui est long.
Mon souhait, serait-il possible d'avoir un message : "Traitement en cours..." pendant l'exécution des macros 2, 3, 4,5 et 6, la première me demande d'inscrire une date au format jj/mm/aaaa, et supprime toute les lignes antérieures à cette date. La 7ème me demande d'entrer le caractère de séparation, virgule ou point-virgule, et le nom du fichier.

Comme il est difficile d'écrire ce à quoi l'on pense, j'ai joint un fichier exemple avec les macros en ordre de marche. Celles-ci pourront-être utiles à des gestionnaires d'associations.

Merci d'avance pour l'aide que vous pourriez m'apporter.

 

[Dranreb]

Bonsoir.
Il y a deux procédures qui pourrait être écrites de telle sorte qu'elles soient beaucoup plus rapides.
La 1ère utilise une fonction LignesOùCondR1C1 qui utilise elle même une fonction PlageÀPartirDe :

Sub EffaceMoinsDate()
   Dim MaDate As Long
   On Error Resume Next
   MaDate = CDate(InputBox("A partir de quelle année ? Format 00/00/0000"))
   If Err Then Exit Sub
   LignesOùCondR1C1(Rows(1), "RC10<" & MaDate).Delete
   End Sub
Function LignesOùCondR1C1(ByVal LigneDéb As Range, ByVal CondR1C1 As String) As Range
Rem. ——— Lignes entières partant de LigneDéb vérifiant une condition R1C1 CondR1C1.
   Dim Rng As Range
   Set Rng = PlageÀPartirDe(LigneDéb.EntireRow): If Rng Is Nothing Then Exit Function
   Set Rng = Rng.Columns(Rng.Columns.Count + 1)
   Application.ScreenUpdating = False
   On Error Resume Next
   Rng.FormulaR1C1 = "=1/(" & CondR1C1 & ")"
   Set LignesOùCondR1C1 = Rng.SpecialCells(xlCellTypeFormulas, 1).EntireRow
   Rng.Delete xlShiftToLeft
   End Function
Function PlageÀPartirDe(ByVal CelDéb As Range) As Range
Rem. ——— Plage utilisée à partir de CelDéb.
   Dim NbrLig As Long, NBrCol As Long
   With CelDéb.Worksheet.UsedRange:
      NbrLig = .Row + .Rows.Count - CelDéb.Row
      NBrCol = .Column + .Columns.Count - CelDéb.Column
      If NbrLig <= 0 Or NBrCol <= 0 Then Exit Function
      End With
   Set PlageÀPartirDe = CelDéb.Resize(NbrLig, NBrCol)
   End Function

L'autre n'accède qu'une seule fois à l'ensemble des cellules de la plage de donnés :

Sub SauveCSV()
   Dim Plage As Range, TDon(), TJn$(), L&, C&, Sep$, NomFic$
   Sep = InputBox("Veuillez entrer le séparateur virgule ou point-virgule : ")
   Set Plage = ActiveSheet.Range("A1:D" & ActiveSheet.Range("A65536").End(xlUp).Row)
   NomFic = InputBox("Veuillez entrer le nom de votre fichier : ")
   Range("G5").Value = NomFic
   TDon = Plage.Value
   ReDim TJn(1 To UBound(Tdon, 2))
   Open "C:\CSV\ " & NomFic & ".csv" For Output As #1
   For L = 1 To UBound(Tdon, 1)
      For C = 1 To UBound(Tdon, 2)
         TJn(C) = TDon(L, C): Next C
      Print #1, Join(TJn, Sep): Next L
   Close #1
   Application.CutCopyMode = False
   MsgBox "Le traitement est terminé", vbOKOnly + vbInformation, "Luc MOUNY"
   End Sub

À tester.

 

[Luc MOUNY]

Bonjour Dranreb, Bonjour à tous

Je suis époustouflé,
1 par la rapidité de la réponse;
2 par sa qualité.

L'accélération est telle, que le message d'attente est devenu inutile, j'ai adapté les modifications à mon fichier réel, qui comporte en réalité plus de colonnes que le classeur test.
Le traitement se fait en 5 ou 6 secondes entre la saisie de la date, et la demande de séparateur et la sauvegarde du fichier.

Vous êtes fabuleux.

Il me reste à comprendre les modifications et le pourquoi d'une telle accélération.

Je vous adresse un énorme merci, ainsi qu'à Excel-Download.

Luc

 

[Dranreb]

Cependant 5 à 6 secondes me paraît encore bien long …
Y a-t-il vraiment beaucoup de lignes traitées ?

 

[Luc MOUNY]

Cependant 5 à 6 secondes me paraît encore bien long …
Y a-t-il vraiment beaucoup de lignes traitées ?

Bonjour,
6 secondes peuvent paraitre longues, pour un spécialiste comme vous, mais pour moi, pour 2500 lignes, avant de me lancer dans cette aventure, par les manipulations classiques d'Excel, les tris, le sélections, les suppressions, les recherches de doublons etc. c'était un travail de plusieurs heures.
Les macros mises en œuvre pour le même travail demandaient presque une minute. En comparaison ça aurait pu me suffire, d'où la demande initiale, alors vous pensez que 5 ou 6 secondes me conviennent.

Merci de vous être intéressé à moi et mon problème.