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

 

[C@thy]

Re : Vba

Oups! ça marche pas terrible, je sélectionne A1 et il me dit 15661 colonnes supprimées alors qu'il n'a rien supprimé!

Bizz

C@thy

 

[job75]

Re : Vba

Re,

Finalement ceci est mieux car plus sûr et plus simple :

Dim n%, derlig&
'-----
With Intersect([O1].Resize(, Columns.Count - 14), ActiveSheet.UsedRange.EntireColumn)
  n = .Count
  '-----
  n = n - .Count
End With
'-----
If n Then
  MsgBox n & " colonne(s) supprimée(s)..."
Else
  MsgBox "Aucune date de fin antérieure à 60 jours..." 'supprimer la ligne inutile
  MsgBox "Aucune colonne sélectionnée à partir de la colonne O..."
End If
End Sub

A+

 

[C@thy]

Re : Vba

Je n'y ciomprends plus rien (fatiguée sans doute?), ça ne supprime plus les colonnes anciennes...

pfff! Besoin de week-end!

Bises

C@thy

 

[C@thy]

Re : Vba

Ah pas testé ta dernière soluce...

Bises bon ouik

C@thy

 

[job75]

Re : Vba

Re,

Ma chère C@thy, t'es-tu rendu compte que les dates en lignes 1 et 2 ne sont pas de "vraies" dates ??

Ce sont des textes et la 1ère chose à faire est de récupérer les dates numériques.

Donc lance cette macro :

Sub RécupérerDates()
Dim tablo, i As Byte, j%, t$
tablo = ActiveSheet.UsedRange.Rows("1:2")
For i = 1 To 2
  For j = 1 To UBound(tablo, 2)
    t = Application.Trim(tablo(i, j)) 'SUPPRESPACE, au cas où...
    t = Mid(t, InStr(t, " ") + 1)
    If IsDate(t) Then tablo(i, j) = CDate(t)
  Next
Next
ActiveSheet.UsedRange.Rows("1:2") = tablo
End Sub

Pour le reste j'ai mis les codes de mon post #32 dans tes macros.

Fichier joint.

A+

 

[C@thy]

Re : Vba

Ah tout s'explique, je comprends tout maintenant,
j'ai bien fait de poster mon fichier, tu as vu le souci.

Un trè très grand merci pour tout, maintenant tout fonctionne nickel chrome

Bises et bon WE

C@thy

 

[C@thy]

Re : Vba

Coucou,

juste un truc à vous signaler :

j'ai trouvé pourquoi on avait le massage d'erreur :

dans une colonne (M), il y avait des 0 jusqu'en bas.

En supprimant ces 0, maintenant on peut supprimer des colonnes, il n'y a plus d'erreur,
du coup j'ai enlevé mon usf, on peut supprimer les colonnes à la main, ça marche.

Pour la suppression des colonnes plus anciennes, j'ai remarqué que lorsqu'il y a un fond de couleur bleu sur des cellules vides, il les prend en compte dans le UsedRange et du coup il met la formule au-dessus de ces colonnes inutilement.

Du coup, comme on n'a plus le problème du message on doit pouvoir se passer de la ligne supplémentaire avec la formule...

mais cela dit, cela fonctionne très bien!

Bises

C@thy