VBA : sélection mutiple et suppression

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

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

L'esclave de service

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

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

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

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

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