Supprimer des lignes automatiquement?

bonjour tout le monde, voici un autre problème que je n'arrive pas à résoudre!!!! je travaille sur une série de données sur excel, mais avant de l'utiliser je dois supprimer quelques lignes selon un critère alors ci-joint un fichier qui explique tout,

Merci pour vos efforts

Bonjour,

Pas besoin de tout le fichier. Quelques dizaines de lignes auraient suffit à résoudre ton problème. Les répondeurs n'aiment pas charger leur DD de Mo inutiles. Sans compter le temps perdu quand on a comme moi une liaison bas débit !

Yaka filtrer sur "AS" et supprimer les lignes visibles. ça m'a pris 4 secondes !

A+

merci pour ta réponse mais, je suis convaincu que pour que les autres te comprennent il faut qu'ils testent sur un exemple, ta proposition ne répond pas au probleme galopin, car je cherche une solution automatique et en plus je ne veux pas supprimer juste la ligne où il y a "AS" mais toutes les lignes de la date à supprimer!!!!!!

Bonsoir,

Voici une macro qui fait a peu près ce que tu demandes. Sauf qu'elle s'arrête quand elle détecte une valeur d'erreur. Il faudra donc faire soigneusement attention à éliminer toute valeur d'erreur de ton fichier. (colonne i )

Je n'ai pas testé non plus si elle est compatible avec le filtre. (car il aurait fallu que je recharge ton fichier...)

Je ne l'ai testée que sans le filtre.

Sub test()
Dim i&, k&
i = Range("A65536").End(3).Row
For k = i To 3 Step -1
On Error GoTo GESTERR
If Cells(k, 9) = "AS" Then
If Cells(k - 1, 1) = Cells(k, 1) Then Cells(k - 1, 9) = "AS"
Rows(k).Delete
End If
Next
Exit Sub
GESTERR:
End Sub

Bon enfin l'essentiel y est. Après c'est du bricolage...

A+

galopin01 a écrit :

For k = i To 3 Step -1

Je me le colle derrière l'oreille, je suis sûr que je serai content de le ressortir un jour

(moi je faisais à base de For k = 3 to i , et k = k-1 avant le Next k, c'est quand même moins classe )

Merci Galopin

Salut le forum

Galopin bienvenue comme nouveau membres pour commencer.

Ta gestion d'erreur est à eviter si tu ne la teste pas

Sub test() 
Dim i&, k& 
i = Range("A65536").End(3).Row 
For k = i To 3 Step -1 
On Error GoTo GESTERR 
If Cells(k, 9) = "AS" Then 
If Cells(k - 1, 1) = Cells(k, 1) Then Cells(k - 1, 9) = "AS" 
Rows(k).Delete 
End If 
Next 
Exit Sub 
GESTERR: 
    'indique le numéro et la description de l'erreur survenue
    MsgBox Err.Number & vbLf & Err.Description
End Sub

Il faut la traiter, imagine la feuille protégée paf !!!!!!!

Exit Sub mais pourquoi ....

Mytå (Ancien modérateur à la retraite)

P.S. Surement une réponse va arriver, du style Heille ta macro à marche pas

bonjour Sylvain, Mytå,

Pourquoi Exit Sub avant la gestion d'erreur ?

Par habitude...

Pourquoi une gestion d'erreur ?

Parce qu'il y a une erreur dans la colonne I et que ça faisait planter la macro !

Pourquoi j'ai pas mis de MsgBox dans la gestion d'erreur ?

Parce que ce très long fichier m'a mis de (très) mauvaise humeur !

Dans ce cas le Msg Err.Number n'est guère plus significatif. Il aurait peut-être plutôt fallu renvoyer le N° de la ligne qui posait problème.

Bref, notre ami est prévenu ! YFO bien lui laisser quelque chose à faire et puis de toute façon j'aurais été obligé de re-télécharger son fichier et j'ai tout de même pas que ça à faire...

A+

Bonjour,

un autre code :

Sub suppr_As()
Dim DerLig As Long, Cel As Range, I As Long, X As Long
Dim MesLig As Object
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
DerLig = [A65000].End(xlUp).Row
Range("A3:A" & DerLig).Name = "base"
Set MesLig = CreateObject("Scripting.Dictionary")
Range("I2").AutoFilter Field:=9, Criteria1:="AS"
    For Each Cel In Range("I3:I" & DerLig).SpecialCells(xlCellTypeVisible)
            If Not MesLig.Exists(Cel.Row) Then MesLig.Add Cel.Row, Cel.Row
    Next Cel
    temp = MesLig.items
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    For I = UBound(temp) To LBound(temp) Step -1
        X = Application.CountIf([base], Cells(temp(I), 1)) - 1
        Cells(temp(I), 1).Offset(-X, 0).Resize(X + 1, 1).EntireRow.Delete
    Next I
    DerLig = [A65000].End(xlUp).Row
    [I3].FormulaR1C1 = _
        "=IF(RC[-8]<>R[1]C[-8],IF(OR(RC[-2]<>R1C4,RC[-1]<>R1C10),""AS"",""ok""),"""")"
    [I3].AutoFill Destination:=Range("I3:I" & DerLig)
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

un grand merci à tous pour vos propositions, juste une chose le code qui répond parfaitement au probleme c'est le dérnier c'est à dire celui de felix, merci Felix