XL 2016 Supprimer plage cellules sous condition

  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

KTM

XLDnaute Impliqué
Bonjours chers tous
Ma macro si dessous supprime les lignes entières si la valeur en G est égale à 0.
Je voudrais supprimer seulement les plages concernées allant de A à G et pouvoir appliquer à une énorme base de données.
Merci.
VB:
Sub suppr()
Application.ScreenUpdating = False
Range("G4:G" & Range("A" & Rows.Count).End(xlUp).Row).Value = Range("G4:G" & Range("A" & Rows.Count).End(xlUp).Row).Value
With Range("G4:G" & Range("A" & Rows.Count).End(xlUp).Row)
    .Replace What:="0", Replacement:="", LookAt:=xlWhole
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
 

Pièces jointes

Bonjour @patty58 😉, @KTM 😉,

Je n'ai pas vraiment compris. Mais voici une proposition sur laquelle m'avait aidé PierreJean (que je salue).
Le code récupère dans une plage les adresses des cellules qui répondent aux conditions. Puis supprime cette plage.
VB:
Option Explicit

Sub Combiner_Plages()
    Dim dl As Long, i As Long, n As Integer, plg As Range
    With ActiveSheet
        dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row
        For i = 4 To dl
            If .Range("A" & i) <> "" And .Range("G" & i).Value = 0 Then
                If plg Is Nothing Then
                   Set plg = .Range("A" & i).Resize(, 7)
                Else
                   Set plg = Application.Union(plg, .Range("A" & i).Resize(, 7))
                End If
            End If
        Next i
    End With
'    MsgBox (plg.Address)
plg.EntireRow.Delete
End Sub

edit :sauf si tu veux ne pas supprimer les lignes de la colonne I, code ci-dessous
VB:
Sub supprimer_lignes()
Dim dl As Long, i As Long, n As Integer, plg As Range
    With ActiveSheet
        dl = .UsedRange.Cells(.UsedRange.Cells.Count).Row
        For i = dl To 4 Step -1
            If .Range("A" & i) <> "" And .Range("G" & i).Value = 0 Then
                .Range("A" & i).Resize(, 7).Delete shift:=xlShiftUp
                End If
        Next i
    End With

End Sub

Joyeuses fêtes de fin d'année.
 
Dernière édition:
Bonjour à tous 🙂,

Pour ce que j'en ai compris : on ne supprime que les lignes entre la colonne A et la colonne G et seulement si la valeur dans la colonne G est 0 (on ne doit pas toucher pas aux autres colonnes à partir de la colonne H).

L'ordre relatif des lignes est conservé lors du traitement.

pouvoir appliquer à une énorme base de données.
Pour 150.000 lignes, ma bécane prend environ 1,30 s.

VB:
Sub suppr()
Dim derlig&, PlageSuppr As Range, debut
   debut = Timer
   Application.ScreenUpdating = False
   If Range("g3") = "AUXIL" Then Columns("g:g").Delete
   If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
   derlig = Range("A" & Rows.Count).End(xlUp).Row
   If derlig <= 3 Then Exit Sub
   Range("G4:G" & derlig).Value = Range("G4:G" & derlig).Value
   Columns("g:g").Insert: Range("g3") = "AUXIL"
   With Range("a4:h" & derlig)
      .Columns(7).FormulaR1C1 = "=IF(RC[1]=0,"""",ROW())"
      .Columns(7).Value = .Columns(7).Value
      .Sort key1:=.Cells(1, 7), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      Intersect(.Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow, .Rows).Clear
   End With
   If Range("g3") = "AUXIL" Then Columns("g:g").Delete
   Application.ScreenUpdating = True
   MsgBox "durée = " & Format(Timer - debut, "0.00 sec.")
End Sub
 

Pièces jointes

Dernière édition:
Bonjour à tous 🙂,

Pour ce que j'en ai compris : on ne supprime que les lignes entre la colonne A et la colonne G et seulement si la valeur dans la colonne G est 0 (on ne doit pas toucher pas aux autres colonnes à partir de la colonne H).

L'ordre relatif des lignes est conservé lors du traitement.


Pour 150.000 lignes, ma bécane prend environ 1,30 s.

VB:
Sub suppr()
Dim derlig&, PlageSuppr As Range, debut
   debut = Timer
   Application.ScreenUpdating = False
   If Range("g3") = "AUXIL" Then Columns("g:g").Delete
   If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
   derlig = Range("A" & Rows.Count).End(xlUp).Row
   If derlig <= 3 Then Exit Sub
   Range("G4:G" & derlig).Value = Range("G4:G" & derlig).Value
   Columns("g:g").Insert: Range("g3") = "AUXIL"
   With Range("a4:h" & derlig)
      .Columns(7).FormulaR1C1 = "=IF(RC[1]=0,"""",ROW())"
      .Columns(7).Value = .Columns(7).Value
      .Sort key1:=.Cells(1, 7), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      Intersect(.Columns(7).SpecialCells(xlCellTypeBlanks).EntireRow, .Rows).Clear
   End With
   If Range("g3") = "AUXIL" Then Columns("g:g").Delete
   Application.ScreenUpdating = True
   MsgBox "durée = " & Format(Timer - debut, "0.00 sec.")
End Sub
Merci à tous pour vos contribution!!
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
461
Réponses
4
Affichages
177
Réponses
6
Affichages
335
Réponses
4
Affichages
552
Retour