Suppression de lignes.

[pascal82]

Bonjour a tous,
J'ai un fichier de 350 000 lignes et je dois supprimer plusieurs lignes selon un critere.
Pour cela en colonne "A" je réalise un test "=SI(ABS(AI2)<0,5;"A";"B")" et j'ai récupéré un code qui me permet de supprimer toutes les lignes contenant "B".

Sub Suppressiondeligne()
Dim Deb As Currency

Deb = Timer
   Application.ScreenUpdating = False

Dim I&
With ActiveSheet
For I = .Range("A350000").End(xlUp).Row To 1 Step -1
If .Cells(I, 1).Value <> "" Then
If Asc(.Cells(I, 1).Value) = 66 Or Asc(.Cells(I, 1).Value) = 98 Then
.Cells(I, 1).EntireRow.Delete
End If
End If
Next I
End With
ActiveWorkbook.Save
             Application.ScreenUpdating = True
                  MsgBox "J'ai bossé " & Timer - Deb & " seconde"
End Sub

Par contre la macro est très longue probablement à cause de la taille du fichier (voisin de 50Mo), c'est pourquoi je tente vainement de plagier le code de "Boigontier"

1.	Sub supLignesRapide()
Application.ScreenUpdating = False
Range("H10:H" & [C65000].End(xlUp).Row).FormulaR1C1 = _
"=IF(sum(RC[-7]:RC[-1])=0,""sup"",0)"
[A10:H1000].Sort Key1:=Range("H10"), Order1:=xlAscending, Header:=xlNo
Range("h10:h65000").SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
Columns("h:h").Clear
End Sub

J'ai besoin d'aide pour adapter ce code a mon fichier.
Merci par avance.

 

[flyonets44]

Re : Suppression de lignes.

Bonsoir
essaie d'adapter ce code

Sub Deleteif_findwordtrue 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Myrange, Urng As Range,C, Lastrow&, Quoi as string
Dim Choix&, Lr&
choix= 0
Lr = Cells(Rows.Count, "A").End(xlUp).Row 
Set myrange =Feuil1.Range("A1:A" & Lr) 
Quoi=ucase("Test")
For Each c In myrange 
   If UCase(c.text) like quoi Then 
        If Urng Is Nothing Then 
            Set Urng = c.EntireRow 
        Else 
            Set Urng = Union(Urng, c.EntireRow) 
        End If 
    End If 
Next 
If Not Urng Is Nothing and choix =1 Then 
Urng.interior.colorindex= 36
else 
Urng.Delete
End If 
set Urng= Nothing :set myrange= Nothing
Application.Calculation = xlCalculationAutomatic
End Sub

Cordialement
flyonets

 

[Guest]

Re : Suppression de lignes.

Bonsoir,

Ne pas mettre 'A' en A1 mais par exemple 'Tri'.
Une fois que tes A et B sont en première colonne, lance cette macro.

Sub supLignesRapide()
Dim c As Range
With ActiveSheet
    .Range("A1").CurrentRegion.Sort key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes
    Set c = .Columns(1).Find(What:="B", LookIn:=xlValues)
    If Not c Is Nothing Then
        .Range(c, .Cells(.Rows.Count, 1).End(xlUp)).EntireRow.Delete xlShiftUp
    End If
End With
End Sub

A+

 

[Staple1600]

Re : Suppression de lignes.

Bonsoir à tous


Avec 0 à la palce de A c'est très rapide 😉

Sub Macro1()

' Macro enregistrée le 09/01/2012 par l'agrafe
'
Application.ScreenUpdating = 0
With Range("A2:A2").Resize([A65536].End(xlUp).Row)
.FormulaR1C1 = "=IF(ABS(RC[34])<0.5,0,""B"")"
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
End With
End Sub

 

[pascal82]

Re : Suppression de lignes.

Bonsoir flyonets44, Hasco, et Staple1600

Je suis impressionné je viens de terminer les tests:
Macro initiale: 5000 lignes en 120s
Macro Hasco: 5000 lignes en 0.1s
Macro Staple: 5000 lignes en 1s
Un grand merci à vous trois, d'une efficacité implacable

Bonne soirée