Microsoft 365 Supprimer ligne selon contenu cellule (résolu)

[Cougar]

Bonjour le forum,

J'essai d'effacer les lignes dans la cellule débute par "CA" mais je ne trouve pas la solution.

Sub Effacer()
Dim plage As Range, c As Range
Sheets("Transferts").Activate
Set plage = Range("H10" & ":H" & Range("H65000").End(xlUp).Row)
For Each c In plage
replen = Left(c.Value, 2)
If replen = "CA" Then Rows(replen).EntireRow.Delete Shift:=xlUp
Next c
End Sub

Merci

 

[N-TR86]

Bonjour le forum,

J'essai d'effacer les lignes dans la cellule débute par "CA" mais je ne trouve pas la solution.

Sub Effacer()
Dim plage As Range, c As Range
Sheets("Transferts").Activate
Set plage = Range("H10" & ":H" & Range("H65000").End(xlUp).Row)
For Each c In plage
replen = Left(c.Value, 2)
If replen = "CA" Then Rows(replen).EntireRow.Delete Shift:=xlUp
Next c
End Sub

Merci

Bonjour,
Votre code présente quelques erreurs:
1) Concaténation incorrecte dans la définition de plage (Set plage)
2) Problème avec Rows(replen).EntireRow.Delete
replen ne contient que les deux premières lettres de c.Value ("CA" dans votre cas), donc Rows(replen) ne correspond pas à une ligne valide.
Lorsqu'on supprime des lignes dans une boucle For Each, il est préférable de parcourir les cellules en sens inverse (de bas en haut), sinon certaines lignes peuvent être ignorées.
Correction du code :

Sub Effacer()
    Dim plage As Range, c As Range
    Dim derniereLigne As Long
    Sheets("Transferts").Activate
    
    ' Trouver la dernière ligne remplie dans la colonne H
    derniereLigne = Range("H65000").End(xlUp).Row
    Set plage = Range("H10:H" & derniereLigne)

    ' Parcourir la plage en sens inverse pour éviter les erreurs lors de la suppression
    For i = plage.Rows.Count To 1 Step -1
        If Left(plage.Cells(i, 1).Value, 2) = "CA" Then
            plage.Cells(i, 1).EntireRow.Delete
        End If
    Next i
End Sub

Merci d'utiliser la balise "CODE" pour mieux visualiser votre code !
Bon courage.

 

[Cougar]

Bonjour N-TR86,

Merci pour le code.

Pour ce qui est de la balise CODE, je ne la connaissais pas.

Merci encore

​

 

[job75]

Bonjour Cougar,

Testez :

Sub Effacer()
With Sheets("Transferts").Range("H10:H" & Rows.Count)
    .Replace "CA*", "#N/A", xlWhole
    On Error Resume Next 'si aucune SpecialCell
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
End With
End Sub

A+

 

[vgendron]

Hello
sinon, une proposition en passant par un filtre pour supprimer en une fois les lignes filtrées

Sub Effacer()
    Dim plage As Range
    Dim derniereLigne As Long
    
    Application.ScreenUpdating = False
    With Sheets("Transferts")
        .Activate
            
        derniereLigne = .Range("H" & .Rows.Count).End(xlUp).Row ' Trouver la dernière ligne remplie dans la colonne H
        Set plage = .Range("H11:H" & derniereLigne)
        
        .Range("H10:L10").AutoFilter
        plage.AutoFilter Field:=1, Criteria1:="=CA*", Operator:=xlAnd
        On Error Resume Next
        plage.SpecialCells(xlCellTypeVisible).EntireRow.Delete
        plage.AutoFilter = False
    End With
    Application.ScreenUpdating = True
End Sub

 

[job75]

Autrement avec votre code il suffit d'écrire :

If replen = "CA" Then c.EntireRow.Delete

 

[mapomme]

Bonsoir @Cougar ,Bonsoir à tous,

En cas d'un nombre important de lignes à traiter, une méthode utilisant une colonne auxiliaire et un tri.
La méthode est connue par certain intervenants de ce fil😉.
La macro fait aussi l'initialisation de la colonne H (20 000 lignes dont 5 000 à supprimer)
C'est assez rapide. Sur ma bécane ça prend environ 0,27 s.

La contrepartie est un code un peu plus long :

Sub Effacer_Gros_Volume()        ' pour un grand nombre de lignes
Dim derlig As Long, dercol, t, i&, Asuppr As String, ColPlus As Boolean, deb#
  
   Feuil2.Range("a:a").Copy Feuil1.Range("h:h")   ' initialisation de la colonne H
   MsgBox "La colonne H a été initialisée. On va entamer la suppression.", vbInformation
  
   deb = Timer                           ' top départ pour mesurer le temps d'exécution
   Application.ScreenUpdating = False          ' plus rapide (écran figé)
   With Worksheets("Transferts")
     .Select                                          ' sélectionne la feuille
     derlig = Cells(Rows.Count, "h").End(xlUp).Row    ' N° de la dernière ligne colonne H
     Columns("i:i").Insert: ColPlus = True            ' on insère une colonne après la colonne H
                                                      ' cette colonne insérée est la colonne i
     dercol = .UsedRange.Column + .UsedRange.Columns.Count   ' N° de la dernière colonne
     t = Range("h10:h" & derlig).Value       ' lecture des valeurs de la colonne H
     For i = 1 To UBound(t)                  ' boucle sur les valeurs de t
       ' si ça commence par "CA" alors on remplace la valeur par "" sinon par i
       If Left(t(i, 1), 2) = "CA" Then t(i, 1) = "" Else t(i, 1) = 1
     Next i
     .Range("i10:i" & derlig) = t  ' on transfère les nouvelles valeurs dans la colonne i
     ' on trie les lignes de la feuille depuis la ligne 10 jusqu'à derlig selon la colonne i
     ' toute les lignes à supprimer se retrouve regropupée en un seul bloc
     .Range("a10:a" & derlig).Resize(, dercol).Sort [i10], xlAscending, Header:=xlNo
     On Error Resume Next   ' au cas où aucune ligne ne serait à supprimer (éviter une erreur d'exécution)
     ' on sélectionne les cellules de la colonne i qui sont vides et on supprime les lignes entières
     .Range("i10:i" & derlig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
     On Error GoTo 0                            ' on rétablit l'interception des erreurs
     If ColPlus Then Columns("i:i").Delete      ' on supprime la colonne i qu'on avait insérée
   End With
   MsgBox Format(Timer - deb, "0.00\ sec."), vbInformation    ' le temps d'exécution
End Sub

 

[job75]

@Cougar ça ne sert à rien d'indiquer que le problème est résolu sans dire quelle solution vous choisissez.

Sur le post qui correspond à la solution, sur la droite il y a une coche : cliquez dessus.