XL 2016 Supprimer 1 sur 13

lynyrd

XLDnaute Impliqué
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
 
Solution
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
 

Phil69970

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 708
Messages
2 112 090
Membres
111 416
dernier inscrit
philipperoy83