Vba

C@thy · 1 Octobre 2013

Bonjour le forum

,

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

Code:

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 · 1 Octobre 2013

Re : Vba

Arf! C'était trop beau,

après la suppression de colonnes, il faut rétablir les dates dans l'ordre initial car cela a un sens de savoir selon quelle chronologie on a passé les opérations

Bizz

C@thy

job75 · 1 Octobre 2013

Re : Vba

Re,

Regarde la formule que j'entre dans les cellules : c'est l'expression à l'intérieur du log qui renvoie VRAI ou FAUX.

A+

job75 · 1 Octobre 2013

Re : Vba

Re,

C@thy à dit:
Arf! C'était trop beau,

après la suppression de colonnes, il faut rétablir les dates dans l'ordre initial car cela a un sens de savoir selon quelle chronologie on a passé les opérations

Allons C@thy, le tri ne modifie pas l'ordre des dates non supprimées puisque l'on trie uniquement des 0 et des #NOMBRE!...

A+

job75 · 1 Octobre 2013

Re : Vba

Re,

Encore un point, pour le tri ceci est peut-être plus rapide :

Code:

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
  .Resize(derlig).Sort Rows(1), xlAscending, Orientation:=xlLeftToRight 'tri
  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

A+

C@thy · 1 Octobre 2013

Re : Vba

Super, Gérard, c'est parfait de chez parfait!

Un milliard de mercis

Bizz

C@thy

C@thy · 2 Octobre 2013

Re : Vba

Coucou, Gérard,

juste encore une petite chose (j'y ai pensé cette nuit!)
pour le plus grand bonheur de mes utilisateur, comme nous n'arrivons pas non plus à supprimer une colonne à la main, je vais faire une boite de dialogue qui donnera le choix (boutons radio) entre :
supprimer les colonnes
1-dont la date d'arrivée est antérieure à 60 jours
2- sélectionnées

par conséquent il faudrait également pouvoir, à partir de la sélection, ne décaler vers la gauche que la plage correspondant à ces colonnes, si tu vois ce que je veux dire... donc, une deuxième macro un peu dans le même style mais qui ne tiendrait pas compte des dates de fin en haut.
Donc pas besoin de tri, si il y a plusieurs colonnes sélectionnées elles seront contigües.
Puis-je encore abuser de ta gentillesse?

En te remerciant grandement.

Bises et bonne journée, ainsi qu'à Marie-Anna.

C@thy

job75 · 2 Octobre 2013

Re : Vba

Bonjour C@thy,

Je crains que tu n'aies pas compris à quoi sert le tri horizontal.

Son seul but est d'accélérer la suppression des dates en les groupant en fin de tableau à droite.

Il est facultatif, tu peux tester en mettant son code en commentaire.

Quant à ton nouveau problème essaie cette macro :

Code:

Sub SupprimerColonnes()
Dim rep As Byte, derlig&
rep = MsgBox("Cliquez sur Oui pour supprimer uniquement les colonnes sélectionnées." _
      & vbLf & "Cliquez sur Non pour supprimer toutes les colonnes.", 51, _
      "Dates de fin antérieures à 60 jours")
If rep = 2 Then Exit Sub 'bouton Annuler
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
  If rep = 6 Then .Value = 0
  IIf(rep = 6, Intersect(Selection.EntireColumn, .Cells), .Cells) _
    .FormulaR1C1 = "=LN(R3C>=TODAY()-60)"
  .Value = .Value 'suppression des formules
  .Resize(derlig).Sort Rows(1), xlAscending, Orientation:=xlLeftToRight 'tri
  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

A+

C@thy · 2 Octobre 2013

Re : Vba

Oui, j'avais bien compris regrouper les colonnes à suppprimer

Un très grand Merci pour cette nouvelle macro. Je teste

Bizz

C@thy

C@thy · 3 Octobre 2013

Re : Vba

Coucou, la suppression de la (les) colonne(s) sélectionnée(s) ne fonctionne pas...
Bises et bonne journée

C@thy

job75 · 3 Octobre 2013

Re : Vba

Bonjour C@thy,

Chez moi, sur le fichier du post #1, aucun problème.

Quelle que soit l'option choisie seules les colonnes dont la date de fin est antérieure à 60 jours sont supprimées.

A+

job75 · 3 Octobre 2013

Re : Vba

Re,

Maintenant si tu veux supprimer les colonnes sélectionnées quelles que soient leurs dates il vaut mieux une seconde macro :

Code:

Sub SupprimerColonnesSelectionnées()
Dim derlig&
If MsgBox("Toutes les colonnes sélectionnées à partir de la colonne O seront supprimées.", 49) = 2 Then Exit Sub
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
  .Value = 0
  Intersect(Selection.EntireColumn, .Cells) = "a"
  .Resize(derlig).Sort Rows(1), xlAscending, Orientation:=xlLeftToRight 'tri
  Intersect(.SpecialCells(xlCellTypeConstants, 2).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

A+

C@thy · 3 Octobre 2013

Re : Vba

Oui, c'est bien ça, quelle que soit la date (= on s'est trompé, on a fait une opération à tort, on supprime la colonne)

je teste et je te dis

Merci, Bisous

C@thy

job75 · 3 Octobre 2013

Re : Vba

Re,

Une autre solution qui donne le même résultat :

Code:

Sub SupprimerColonnesSelectionnées()
Dim derlig&
If MsgBox("Toutes les colonnes sélectionnées à partir de la colonne O seront supprimées.", 49) = 2 Then Exit Sub
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
  .Value = 0
  Intersect(Selection.EntireColumn, .Cells).ClearContents 'cellules vides
  .Resize(derlig).Sort Rows(1), Orientation:=xlLeftToRight 'tri
  Intersect(.SpecialCells(xlCellTypeBlanks).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

Quel que soit l'ordre du tri les cellules vides se retrouvent à la fin.

A+

C@thy · 4 Octobre 2013

Re : Vba

Coucou,

alors voilà, j'ai testé, c'est parfait,
j'ai fait un userform avec 2 boutons radio pour supprimer
1- les col date fin < 60j
2- les col. sélectionnées

il manque juste un message lorsque
- dans le 1er cas il n'y a pas de date < à 60 jours
- dans le 2ème cas on a sélectionné une mauvaise colonne (avant la col O)
et pis à la fin pour dire qu'il l'a fait... (suppression effectuée).

Un grand MERCI, Gérard

Bises et bonne jounée

C@thy

job75 · 4 Octobre 2013

Re : Vba

Bonjour C@thy,

C@thy à dit:
il manque juste un message (...)

Une solution bien simple, tu places au début des 2 macros :

Code:

Dim ncol%, derlig&
ncol = [O1].CurrentRegion.Columns.Count

et à la fin des macros :

Code:

If [O1].CurrentRegion.Columns.Count < ncol Then
  MsgBox ncol - [O1].CurrentRegion.Columns.Count & " 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

Pour la 2ème MsgBox n'oublie pas de supprimer la ligne inutile.

Edit : [O1].CurrentRegion est préférable à ActiveSheet.UsedRange...

A+

Effectuez une recherche sur Excel Downloads...

Vba

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

C@thy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums