XL 2010 suppression de lignes dans un fichier EXCEL via une routine en VBA

[dadu35]

Bonjour,
j'ai créé une routine permettant de supprimer des lignes dans un fichier Excel:
Pour chaque bâtiment d'une société, j'ai une ligne "bâtiment Salle . . . ." . Donc une ligne par couple "Bâtiment - Salle".
Je souhaite par cette routine supprimer tous les enregistrements concernant un bâtiment.

Ma routine supprime la ligne précédente, si bien qu'au final :
1 - suppression de la dernière ligne du bâtiment précédent
2 - il reste une ligne du bâtiment traité

Où se trouve la coquille dans ma routine ?

Merci pour une réponse
Daniel

' Suppression des lignes actuelles pour ce batiment

    TopFin = "N"
    Ib = 2

    While TopFin = "N"
        If Cells(Ib, 1) = "" Then
            TopFin = "O"
        Else
            If Cells(Ib, 1).Value = BatNom Then
                MsgBox " Salle " & Cells(Ib, 2)
                Cells(Ib).EntireRow.Delete
                'Row(Ib).EntireRow.Delete
            Else
                Ib = Ib + 1
            End If
        End If
    Wend

 

[Phil69970]

Bonjour @dadu35

Le principe quand on supprime une ou des ligne(s) d'une feuille on commence par le bas et on remonte vers le haut

Exemple

For i = 100 to 1 step -1 'De la ligne 100 à la ligne 1
Range("A" & i).Delete
Next i

Dans cet exemple on supprime la ligne 100 puis 99, 98, 97 ..... bien sur on peut rajouter une ou des conditions...

Bonne lecture

 

[mapomme]

Bonjour @dadu35 , @Phil69970 ,

Pour le fun, une tentative de procédure "générique" qui supprime les lignes complètes d'une feuille si dans la colonne X on trouve une valeur particulière. La procédure est plutôt rapide. Elle utilise une colonne auxiliaire avec formule et tri.

La procédure : SupprimerLignes ( xrgColonneRecherche , LaValeur , premLigne )

• xrgColonneRecherche est un objet range dont la première colonne sera la colonne de recherche
• LaValeur est un nombre, une chaine de caractère dont la présence dans la colonne de recherche provoquera la suppression de toute la ligne
• premligne est un numéro absolu de ligne (donc à partir de la 1ère ligne de la feuille). On ne recherchera LaValeur qu'à partir de cette ligne premligne. Autrement dit, les lignes 1 à (premLigne-1) seront toujours conservées quoiqu'elles contiennent.

exemple d'utilisation : SupprimerLignes range(c3:f5) , "toto" , 2)
On recherche si les cellules de toute la colonne C sont égales à "toto". Si c'est le cas, la ligne entière de la feuille de calcul de ces cellules seront supprimées. La recherche commencera à la ligne 2.

Le code de la procédure. Le code est commenté, c'est pourquoi il parait long :

Sub SupprimerLignes(xrgColonneRecherche As Range, LaValeur, premLigne As Long)
Const EnTeteColAux = "aux-col à supprimer-aux"     ' titre de la colonne auxiliaire
Dim derlig As Long, dercol As Long, auxcol As Long, t, i

   With xrgColonneRecherche.Parent
      ' la colonne de recherche
      ' suppression d'une éventuelle précédente colonne auxiliaire non supprimée
      i = Application.IfError(Application.Match(EnTeteColAux, .Rows(1), 0), 0)
      If i > 0 Then .Columns(i).Delete
      ' dernière ligne et colonne utilisées sur la feuille et numéro de la colonne auxiliaire
      derlig = .UsedRange.Row - 1 + .UsedRange.Rows.Count
      dercol = .UsedRange.Column - 1 + .UsedRange.Columns.Count
      auxcol = dercol + 1
      ' array des valeurs de la colonne avec les valeurs à supprimer
      t = .Columns(xrgColonneRecherche.Column).Resize(derlig)
      ' boucle sur t
      ' jusqu'à (premligne -1), on affecte à t(i,1) le numéro de ligne
      For i = 1 To premLigne - 1: t(i, 1) = i: Next
      ' puis jusqu'à la fin de t ==> si t(i,1) =Valeur alors t(i,1)= "#N/A" sinon le numéro de ligne
      For i = premLigne To UBound(t)
         If IsError(t(i, 1)) Then
            t(i, 1) = i
         Else
            t(i, 1) = IIf(t(i, 1) = LaValeur, "#N/A", i)
         End If
      Next i
      ' on affecte à t(i,1) le bon titre (titre de la colonne auxiliaire)
      t(1, 1) = EnTeteColAux
      ' écriture de t dans la colonne auxiliaire
      .Cells(1, auxcol).Resize(UBound(t)) = t
      ' tri selon la colonne auxiliaire
      .Range("a1").Resize(derlig, auxcol).Sort key1:=.Cells(1, auxcol), order1:=xlAscending, Header:=xlYes
      On Error Resume Next
      ' suppression des lignes contenant une erreur dans la colonne auxiliaire
      .Cells(1, auxcol).Resize(derlig).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
      On Error GoTo 0
      ' suppression de la colonne auxiliaire
      i = Application.IfError(Application.Match(EnTeteColAux, .Rows(1), 0), 0)
      If i > 0 Then .Columns(i).Delete
   End With
End Sub

Le fichier joint compare les durées d'éxécution par une méthode classique à boucle (du bas vers le haut) et la méthode avec une colonne auxiliaire sur la feuille de calcul.