Vba

[C@thy]

Bonjour le forum,

j'ai une macro qui fonctionnait super bien sous 2003, mais avec 1 million de lignes ça ne passe plus :

Sub SupprimerColonnes()
Dim c As Long, dercol As Long, Plg As Range, derlig As Long, réponse As Byte
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
derlig = Cells(1048576, 1).End(xlUp).Row 'rajouté por faire la modif
réponse = MsgBox("Attention vous allez supprimer des colonnes dont la date de fin est antérieure à 60 jours", vbOKCancel, 48)
If réponse = 1 Then
dercol = [XFD1].End(xlToLeft).Column 'modifié pour 2010
For c = 15 To dercol
    If Cells(2, c) < Date - 60 Then
        If Plg Is Nothing Then
            Set Plg = Columns(c)
        Else
             Set Plg = Union(Plg, Columns(c))
        End If
    End If
Next c
Plg.Select
If Not Plg Is Nothing Then Plg.Delete
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
End If
End Sub

et là, patatras, message "Excel ne peut terminer cette tâche avec les ressources disponibles sélectionnez moins de données ou fermez des applications"...
mais je n'ai qu'Excel d'ouvert...

il ne faut donc pas supprimer toutes les colonnes, mais juste la partie correspondant à la hauteur du tableau (dernière ligne rempli col. A) et décaler vers la gauche

Comment puis-je corriger proprement mon code???

Un très grand MERCI à ceux qui voudraient bien se pencher sur cette question.

Bises et bonne journée

C@thy

 

[JBARBE]

Re : Vba

Bonjour à tous,

Je ne sais pas si c'est la bonne solution mais si le nombre de ligne et > à 65536 la macro peut-être adaptée pour un fichier avec l'extension xls d'Excel 2003 et inférieur !

mais cela tout le monde le sait et peut-être pas la solution pour votre probléme !

La modif !

derlig = Cells(65536, 1).End(xlUp).Row 'rajouté por faire la modif

Bonne journée

 

[Dranreb]

Re : Vba

Bonjour.

À essayer quand même me semble-t-il :

For c = Dercol to 15 Step -1
    If Cells(2, c) < Date - 60 Then Columns(C).Delete
Next C

 

[job75]

Re : Vba

Bonjour C@thy salut JBARBE, Dranreb,

Avec cette méthode, le problème se pose quand il y a beaucoup de zones disjointes à mémoriser.

Que ce soit pour des lignes ou des colonnes, une solution est d'effectuer un tri pour placer les zones à supprimer à la fin.

Je vais regarder ça.

A+

 

[C@thy]

Re : Vba

Coucou et merci à tous de vous pencher sur mon problème.

Les colonnes sont en générales côte à côte car normalement on fait les opérations au fur et à mesure, mais il peut arriver qu'on fasse une opération pour une date future (prévision), et que du coup, ce ne soit plus trié si on fait d'autres opérations à la date du jour ensuite...

cela dit, même à la main, si j'essaie de supprimer toute une colonne j'ai le même message (mon fichier est très gros!), alors que si je supprilme sur la hauteur du tableau en décalant les cellules vers la gauche cela fionctionne

Bizz

C@thy

 

[C@thy]

Re : Vba

Voici une partie de mon classeur,
si le classeur ne comporte que cette feuille, cela fonctionne très bien (mais lentement),
mais j'ai beaucoup d'autres feuilles et beaucoup d'autres macros dans ce classeur...

Bises

C@thy

 

[job75]

Re : Vba

Re,

Essaie cette macro :

Sub SupprimerColonnes()
If MsgBox("Attention vous allez supprimer des colonnes dont la date de fin est antérieure à 60 jours...", 49) = 2 Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next 's'il n'y a aucune colonne à supprimer
[1:1].Insert 'ligne auxiliaire
With Intersect([O1].Resize(, Columns.Count - 14), ActiveSheet.UsedRange.EntireColumn)
  .FormulaR1C1 = "=LN(R3C>=TODAY()-60)"
  .Value = .Value 'suppression des formules
  .EntireColumn.Sort Rows(1), xlAscending, Orientation:=xlLeftToRight
  .SpecialCells(xlCellTypeConstants, 16).EntireColumn.Delete
  .EntireColumn.AutoFit 'ajustement automatique
End With
[1:1].Delete 'suppression de la ligne auxiliaire
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

A+

 

[C@thy]

Re : Vba

Merci Gérard, je viens d'essayer, même punition!
même à la main (donc sans macro) je n'arrive pas à supprimer une colonne entière, j'ai le message...

Bises

C@thy

 

[C@thy]

Re : Vba

Gérard, dans mon fichier test qui ne comporte qu'une seule feuille, ta macro s'exécute 3 fois plus vite que celle que j'ai postée.

Dans le gros classeur, aucune ne s'exécute, j'ai le message indiqué.

Bizz

C@thy

 

[C@thy]

Re : Vba

Ah! J'ai une piste :

en pas à pas ta macro fonctionne sur le gros fichier,
faudrait-il ralentir l'exécution avec un wait???

P.S. tu m'expliqueras cette histoiire de logarythme népérien...

Bizz

C@thy

 

[job75]

Re : Vba

Re,

Bizarre...

Essaie cette macro :

Sub SupprimerColonnes()
If MsgBox("Attention vous allez supprimer des colonnes dont la date de fin est antérieure à 60 jours...", 49) = 2 Then Exit Sub
Dim derlig&
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
On Error Resume Next 's'il n'y a aucune colonne à supprimer
[1:1].Insert 'ligne auxiliaire
With Intersect([O1].Resize(, Columns.Count - 14), ActiveSheet.UsedRange.EntireColumn)
  derlig = .EntireColumn.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
  .FormulaR1C1 = "=LN(R3C>=TODAY()-60)"
  .Value = .Value 'suppression des formules
  .EntireColumn.Sort Rows(1), xlAscending, Orientation:=xlLeftToRight
  Intersect(.SpecialCells(xlCellTypeConstants, 16).EntireColumn, Rows("1:" & derlig)).Delete xlToLeft
  .EntireColumn.AutoFit 'ajustement automatique
End With
[1:1].Delete 'suppression de la ligne auxiliaire
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

- je ne supprime pas des colonnes entières mais des colonnes limitées

- j'ai ajouté des EnableEvents pour bloquer d'éventuelles macros événementielles.

A+

 

[C@thy]

Re : Vba

Deuxième info :

je viens de relancer la macro et... ô miracle, ça fonctionne!
pourvu que ça dure!!!

Edit : Oups! pas vu ta réponse, j'essaie...

C@thy

 

[C@thy]

Re : Vba

OK, super nickel, cela fonctionne,

génial ton

derlig = .EntireColumn.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row

j'adore, et c'est exactement ce qu'il me fallait!

Bravo l'artiste!

Mille milliards de MERCI

Big bisous et bonne soirée
(moi je vais à la piscine!)

C@thy

 

[job75]

Re : Vba

Re C@thy,

Heureux que ça fonctionne mais j'aimerais bien savoir pourquoi il y avait problème

P.S. tu m'expliqueras cette histoiire de logarythme népérien...

LN(VRAI) = LN(1) = 0

LN(FAUX) = LN(0) = #NOMBRE!

Le tri horizontal rassemble les valeurs d'erreur à droite.

A+

 

[C@thy]

Re : Vba

Ben voyons! Euh... pourquoi le log népérien est vrai ou faux???

C@thy