XL 2016 Supprimer 1 sur 13

lynyrd · 19 Mars 2024

Bonjour le forum
Sur le site j'ai récupéré ce code VBA qui pes pour supprimer 1 ligne sur 2
J'aimerais que ce soit 1 ligne touts les 13
Merci.

VB:

Sub a()
Dim p As Range
Set p = Range([A1], [A65536].End(xlUp)) 'ici définit la plage de cellules utiles de la colonne A
Application.ScreenUpdating = False
With p.Offset(, 255) 'insére la formule en colonne IV (car test fait sur PC avec XL2003)
    .FormulaR1C1 = "=IF(MOD(ROW(),2)=0,1,"""")" ' la formule en question
    .Value = .Value ' simule le copie/colle -> Valeurs seules
    .SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
' utilise SpecialCells pour sélectionner les lignes avec un valeur numérique
'en colonne IV et supprime ces lignes
End With
End Sub

Phil69970 · 19 Mars 2024

Re

@lynyrd

VB:

Sub Test()
Dim Derlig&, i&, Cpt&
Derlig = Range("A" & Rows.Count).End(xlUp).Row
Cpt = 1
For i = 2 To Derlig
    If Cpt <> 14 Then
        Range("B" & i) = Cpt ' *Voir commentaire
        Cpt = Cpt + 1
    Else
        Cpt = 1
    End If
Next i
Range("B1:B" & Derlig).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' *Voir commentaire
End Sub

* Si la colonne B de ton fichier est utilisé tu mets une colonne non utilisé exemple

Range("Z1:Z" & Derlig).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete

Merci de ton retour

Phil69970 · 19 Mars 2024

Bonjour @lynyrd rd

Je te propose ceci :

Sub a()
Dim p As Range
Set p = Range([A1], [A65536].End(xlUp)) 'ici définit la plage de cellules utiles de la colonne A
Application.ScreenUpdating = False
With p.Offset(, 255) 'insére la formule en colonne IV (car test fait sur PC avec XL2003)
.FormulaR1C1 = "=IF(MOD(ROW(),13)=0,1,"""")" ' la formule en question
.Value = .Value ' simule le copie/colle -> Valeurs seules
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
' utilise SpecialCells pour sélectionner les lignes avec un valeur numérique
'en colonne IV et supprime ces lignes
End With
End Sub

Merci de ton retour

Phil69970 · 19 Mars 2024

Re

Autrement il y a cela aussi qui fonctionne mais on supprime en partant de la fin et on remonte au début toutes les 13 lignes

VB:

Sub test()
Application.ScreenUpdating = False
Dim Derlig&, i&

Derlig = Range("A" & Rows.Count).End(xlUp).Row
For i = Derlig To 1 Step -13
    Rows(i).Delete
Next
End Sub

lynyrd · 19 Mars 2024

Bonjour phil69970
non ,ce n'est pas ce que je souhaite
je vais mettre un exemple
Merci

Phil69970 · 19 Mars 2024

Re

@lynyrd

Je t'ai donné 2 solutions
La 1ere au post #2 en reprenant la macro que tu as posté qui supprime 1 ligne sur 13 en partant du début

La 2eme au post #3 en supprimant 1 ligne sur 13 mais en partant de la fin

Edirt je viens de voir ton fichier ==>je regarde ....

Phil69970 · 19 Mars 2024

Re

@lynyrd

VB:

Sub Test()
Dim Derlig&, i&, Cpt&
Derlig = Range("A" & Rows.Count).End(xlUp).Row
Cpt = 1
For i = 2 To Derlig
    If Cpt <> 14 Then
        Range("B" & i) = Cpt ' *Voir commentaire
        Cpt = Cpt + 1
    Else
        Cpt = 1
    End If
Next i
Range("B1:B" & Derlig).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete ' *Voir commentaire
End Sub

* Si la colonne B de ton fichier est utilisé tu mets une colonne non utilisé exemple

Range("Z1:Z" & Derlig).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete

Merci de ton retour

lynyrd · 19 Mars 2024

C'est tu bon Phil69970
Nickel.
Merci
A+

XL 2016 Supprimer 1 sur 13

lynyrd

XLDnaute Impliqué

Phil69970

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

lynyrd

XLDnaute Impliqué

Pièces jointes

Phil69970

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

lynyrd

XLDnaute Impliqué

Discussions similaires