VBA : sélection mutiple et suppression Fermé

Question

Bonjour à tous

je ne sais pas dans quelle rubrique poser ma question !!!

J'ai 1 fichier de 54000 lignes et 5 colonnes.
Il faut que je supprime 1 ligne sur 2.
Je réussi à le faire dans une boucle for next

For i = 2 To nptotal + 1
Rows(i).Select
Selection.Delete Shift:=xlUp
Next

mais l'exécution est très longue.
Je souhaiterais faire une sélection multiple d'1 ligne sur 2 (à l'aide d'1 boucle peut être), puis supprimer la sélection en 1 seule opération, ce qui je pense gagnerait beaucoup en temps d'exécution.
Mais voilà, je n'arrive pas à faire cette sélection.
Auriez vous des propositions.

Merci d'avance

michel_m · Answer

Bonjour,

Pourquoi  ne pas indiquer  quelle colonnes sont concernées, d'où viennent les variables que tu utilises comme nptotal....

pas très encourageant pour essayer de t'aider

un code à adapter à ton appli

Option Explicit

Sub supprimer_1sur2()
Dim Derlig As Long
Dim T_tout(), T_demi
Dim cptr As Long, col As Byte
Dim start As Single

start = Timer
Application.ScreenUpdating = False
Derlig = Columns("A").Find("*", , , , , xlPrevious).Row
T_tout = Range("A2:E" & Derlig).Value
ReDim T_demi(Int(Derlig / 2), 4)

For cptr = 1 To UBound(T_tout) Step 2
     For col = 0 To 4
          T_demi(Int(cptr / 2), col) = T_tout(cptr, col + 1)
     Next
Next
Range("A2:E" & Derlig).Clear
Range("A2").Resize(UBound(T_demi) + 1, 5) = T_demi

Application.ScreenUpdating = True
MsgBox "Durée: " & Timer - start & " sec."
End Sub

LouisBlanc · Answer

Merci.

J'ai bosser sur une macro tout le weekend et une grande partie de la nuit.
Je suis obligé de décrocher maintenant.
Je fournirai plus d'infos la prochaine fois.
Normalement je reprends ça la semaine prochaine.

Je testerai ta proposition et reviendrai sur le forum

Cordialement

eriiic · Answer

Bonjour à tous,

Si c'est toute les lignee entières que tu supprimes tu peux le faire sans macro, ça prend 20s.
- insérer une colonne et y saisir en A1 =mod(ligne();2)
- recopier jusqu'en bas par un double-clic sur la poignée de recopie.
- copier-collage spécial valeur sur la colonne A
- trier sur A
- sélectionner les lignes avec 0 (ou 1) et supprimer

eric

LouisBlanc · Answer

L'objectif est d'automatiser le traitement d'un fichier. Cette opération n'est qu'une toute petite partie. J'ai trouver quelques solutions, je vous en ferez profiter dès que ce sera au point.

Cordialement

Patrice33740 · Answer

Pour gagner du temps il faut partir de la fin.(il y aura 2 fois moins de lignes à déplacer)

michel_m · Answer

On attend depuis 9 jours ta réaction....
ou peut-^tre tout simplement  un "coucou, merci pur le temps passé"

L'esclave de service

LouisBlanc · Answer

Bonjour à tous

Projet non terminé, pas le temps de m'y mettre en ce moment.

Pas d'esclave... ni de coucou.... juste en situation de débordement.

Ci dessous partie de code commentée que j'ai adapté à partir de vos différentes aides. Y a sûrement moyen de faire mieux, mais pas le temps de creuser.

Sub ess5()

''avant ça, j'importe un fichier de données TXT qui comprend 18 lignes d'entête
''et un tableau de valeurs de 57600 lignes et 5 colonnes qui commence en cellule A19
''ce tableau doit être nettoyé d'une ligne sur deux

Application.ScreenUpdating = False

'récupération du nom de sauvegarde
NomDeSauvegarde = ActiveSheet.Name & ".xls"

nbligne = 57600 'nombre de ligne du tableau
nbcolonne = 5 'nombre de colonne du tableau
nbligne2 = nbligne / 2 'nombre de ligne après réduction des données

'début de chrono
temps = Timer

'suppression des lignes

'création des variables tableau
tablo1 = Range(Cells(19, 1), Cells(19 + nbligne, nbcolonne)).Value 'transfert du tableur dans tableau
ReDim tablo2(1 To nbligne2, 1 To nbcolonne) 'définition de la taille du tableau dynamique qui recevra les nouvelles données

'boucle de transfert des données d'un tableau à l'autre
For i = 1 To nbligne Step 2
x = x + 1
    For j = 1 To nbcolonne Step 1
    tablo2(x, j) = tablo1(i, j)
    Next j
j = 0
Next i

'création de la feuille des données préparées
Sheets.Add
ActiveSheet.Name = "Données traitées"
Range("A1:e" & nbligne2).Value = tablo2 'transfert du tableau dans tableur

'mesure du temps d'éxécution et affichage
duree = Timer - temps
MsgBox "Temps d'éxécution = " & Format(duree, "0.00 \s") & Chr(13) & "Cliquer sur OK pour terminer"

End Sub

VBA : sélection mutiple et suppression

7 réponses

Discussions similaires