Macro: supprimer x ligne sur y

re,
Désolé mais j'étais sur une autre discussion...

Option Explicit
Option Base 1
Sub Supprimer_svt_pas()
Dim Pas As Byte
Dim Ligfin As Long, T_in(), T_out(), Idx As Long, Cptr As Long, Col As Byte
Dim start As Single

ReDim T_out(3, 1)

Application.ScreenUpdating = False
On Error GoTo Erreur
Pas = Application.InputBox("saisir le Pas de suppression désiré", 1)
On Error GoTo 0
start = Timer

'mémorisation tableaux en RAM
Ligfin = Columns("A").Find("*", , , , , xlPrevious).Row
T_in = Range("A5:C" & Ligfin)

For Idx = 1 To UBound(T_in) Step Pas
     Cptr = Cptr + 1
     ReDim Preserve T_out(3, Cptr)
     For Col = 1 To 3
          T_out(Col, Cptr) = T_in(Idx, Col)
     Next
Next

'A SUPPRIMER APRES ESSAIS
Range("F5").Resize(Cptr, 3) = Application.Transpose(T_out) 'pour essais
Range("F5:H" & Cptr).Borders.Weight = xlThin
Application.ScreenUpdating = True
MsgBox "suppression effectuée en :" & Timer - start & " .sec."

'A ACTIVER APRES ESSAIS
'Range("A5:C150000").Clear
'Range("A5").Resize(Cptr, 3) = Application.Transpose(T_out) 'pour essais
'Range("A5:C" & Cptr).Borders.Weight = xlThin

Exit Sub
Erreur:
     MsgBox " la saisie doit être un nombre!", vbCritical
End Sub

Avec un pas de 2 :durée env 0,09 sec avec un vieux coucou (512 ram) proche de la retraite

Ton classeur en retour
https://www.cjoint.com/?3FqqkTsIMWW

1. Prendre pour la feuille But (FB) la feuille source (FS)
2. Effacer la feuille source avant d'y envoyer le tableau T

Ce qui donnerait

Option Explicit
Option Base 1

Const FS = "Feuil3"
Const FB = "Feuil3"
' a partir de la ligne 5 on supprime 4 lignes toutes les 10 lignes
Const lideb = 5
Const nblisupp = 4
Const pas = 10

Const nbco = 3
Const codeb = 1

Public Sub SuppLignes2()
Dim lifin As Long, li2 As Long, nbpas As Long, li1 As Long, co As Long
Dim T, nbli As Long, lit As Long, s As Single
Application.ScreenUpdating = False
s = Timer
With Sheets(FS)
 lifin = .Cells(Rows.Count, codeb).End(xlUp).Row
 nbpas = 1 + (lifin - lideb) \ pas
 lifin = lideb + (nbpas) * pas + nblisupp - 1
 nbli = nbpas * (pas - nblisupp)
 ReDim T(1 To nbli, 1 To nbco)
 lit = 1
 On Error GoTo suite
 For li1 = lideb To lifin Step pas
   For li2 = li1 + nblisupp To li1 + pas - 1
     For co = 1 To nbco
       T(lit, co) = .Cells(li2, co)
     Next co
     lit = lit + 1
   Next li2
 Next li1
End With
Sheets(FS).Range(Cells(lideb, codeb), Cells(lifin, codeb + nbco - 1)).ClearContents
Sheets(FB).Cells(lideb, codeb).Resize(nbli, nbco) = T
Application.ScreenUpdating = True
MsgBox "temps mis " & Timer - s & " s"
End Sub

Cdlmnt

Bonjour,

For x = 1 To 100000 Step 4

    Rows(x).Delete.
    x = x - 1

Next

Step 4 signifie que x s'incrémente de 4. Ici, à la première boucle, x = 1, à la seconde x = 4, à la troisième x = 7 etc.

"Il vaut mieux savoir tout chercher que chercher à tout savoir."

Merci pour ta réponse rapide mais VBA me dis qu'il y a une erreur de syntaxe à la ligne:

Rows(x).Delete.

Bonjour,

Pas de . à la fin de la ligne

Un peu plus optimisé :

Sub suppLig()
    Application.ScreenUpdating = False
    For lig = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -4
        Rows(lig).Delete
    Next
End Sub

Mais ne sera pas plus rapide qu'en ajoutant une colonne avec =MOD(LIGNE();4)
Et avec un filtre automatique sur 'différent de 0' supprimer les lignes visibles.

eric

Oui désolé, je sais pas pk il m'a ajouté un point après Delete... Une erreur de ma part sans doute.

Merci les 2 macros fonctionnent bien mais prennent beaucoup de temps à cause de la boucle je suppose étant donnée que j'ai environ 100 000 lignes à traiter.

Existe t il un moyen de faire plutôt une sélection d'1 ligne sur 4 (ou 2 lignes sur 3) avec 1 seule suppression? Genre:

Rows("1 ligne sur 4").Select
Selection.delete Shift:=xlUp

Sinon j'ai essayé d'utilisé la technique du filtre automatique avec =MOD(LIGNE();4) (que je ne connaissais pas). Ça fonctionne bien mais je n'ai pas trouvé comment automatiser la suppression des lignes visibles.

Bonjour à tous,

Pour essayer un traitement rapide:

Combien de colonnes au tableau ?

1° colonne : A ?
départ en ligne 2 ?

Si possible
mettre un extrait du classeur (env.1000 lignes maxi) sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse

Merci d'avance

Michel

Bonjour,

Mon fichier brut a 3 colonnes (A, B et C).
Les 3 premières lignes sont des titres et des unités.
Les données à traiter commencent en ligne 5.

Extrait de 500 lignes d'une feuille d'un de mes fichiers brut:
https://www.cjoint.com/?0FqmTq54wMS

Merci de votre aide

Effectuer la suppression de 100.000 / 4 lignes ou sélectionner 100.000 / 4 lignes pour les supprimer toutes d'un coup revient au même question temps d'exécution.

Bonjour

un essai

Option Explicit

' a partir de la ligne 2 on supprime 4 lignes toutes les 10 lignes
Const lideb = 2
Const nblisupp = 4
Const pas = 10

' colonne renseignée
Const co = "A"

Public Sub SuppLignes()
Dim lifin As Long, li2 As Long, nbpas As Long, li1 As Long
Application.ScreenUpdating = False
With ActiveSheet
 lifin = .Range(co & Rows.Count).End(xlUp).Row
 nbpas = 1 + (lifin - lideb) \ pas
 lifin = lideb + (nbpas - 1) * pas + nblisupp - 1
 For li2 = lifin To lideb Step -pas
   li1 = li2 - nblisupp + 1
   .Rows(li1 & ":" & li2).Delete
 Next li2
End With
Application.ScreenUpdating = True
End Sub

Cdlmnt

Un essai avec traitement en mémoire qui devrait aller plus vite
https://www.cjoint.com/?3Fqp0HuVHX1

Cdlmnt

Merci ccm81 ça fonctionne très bien et très rapidement! Par contre pour l'utiliser sur mon fichier j'ai du renommer la feuille de résultat en "feuil3" et créer la "feuil4" où les résultats sont copiés. Est il possible de s'affranchir de cela? Je ne traite que des copies de mes fichiers brut donc ça ne me dérange pas si les feuilles de calculs sont écrasées.

Encore merci

Merci aussi michel_m ça fonctionne également très bien et très rapidement! J'ai maintenant ce qu'il me faut pour traiter rapidement mes résultats.

Un grand merci aussi à tous ceux qui on pris sur leur temps pour m'aider. Je mets le sujet en RESOLU.

Bonne journée tous le monde