XL 2016 Supprimer plage cellules sous condition

[KTM]

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.

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

 

[patty58]

Bonjour

Est-ce cela que tu veux faire ??

Bonne journée

 

[cp4]

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.

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

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.

 

[mapomme]

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.

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

 

[KTM]

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.

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!!