Macro trie et suppression

Version imprimable

Bonjour,
J'ai un tableau de données d'un robot de traite, à chaque passage au robot, une ligne se créée.
Je voudrais une macro qui trie ces données en fonction du numéro de la vache et de la date de traite.
Seulement les lignes où dans la colonne action la vache est marquée "refusée" ou "relachée non traite" gênent à la synthèse des données, je souhaiterais donc qu'en plus du trie, la macro supprime toutes les lignes lorsqu'il y a refusée ou relachée non traite.
Le tableau devant être actualisé au fur et à mesure des traites, il ne peut y avoir de frontière vers le bas.
Ma macro ne marchant je souhaiterais comprendre les erreurs, merci
Je joins le fichier excel
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 Sub Filtre() ' ' Filtre Macro ' ' ActiveWorkbook.Worksheets("donnees_robots_lot1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("donnees_robots_lot1").Sort.SortFields.Add Key:= _ Range("A6:A5051"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ :=xlSortTextAsNumbers ActiveWorkbook.Worksheets("donnees_robots_lot1").Sort.SortFields.Add Key:= _ Range("B6:B5051"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _ :=xlSortTextAsNumbers With ActiveWorkbook.Worksheets("donnees_robots_lot1").Sort .SetRange Range("A5:AK5051") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply Sub Supprime() Dim i As Long Dim e As Long Dim A As String Sheets("donnees_robots_lot1").Select For i = 1 To Range("A6").End(xlUp).Row If UCase(Cells(i, 1).Value) = "Refusée" Then Exit For Next i For e = i + 1 To Range("A6").End(xlUp).Row If UCase(Cells(e, 1).Value) = "Relachée non traite" Then Exit For Next e A = CStr(i + 1) & ":" & CStr(e - 1) Rows(A).Select Selection.Delete Shift:=xlUp Range("A" & i).Select End With End Sub
Merci pour votre aide

Bonjour,

Essaie comme ceci (non testé) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Filtre()
'
' Filtre Macro
'
 
'
    Dim Ligne As Long
    With ActiveWorkbook.Worksheets("donnees_robots_lot1")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A6:A" & Ligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortTextAsNumbers
        .Sort.SortFields.Add Key:=.Range("B6:B" & Ligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortTextAsNumbers
        With .Sort
            .SetRange Range("A5:AK" & Ligne)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub
Sub Supprime()
    Dim i As Long
    Dim e As Long
    Dim A As String
    Dim Ligne As Long
    With Sheets("donnees_robots_lot1")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row - 1
        For i = Ligne To 1 Step -1
            If LCase(Cells(i, 1).Value) = "refusée" Or _
                LCase(Cells(i, 1).Value) = "Relachée non traite" Then
                Rows(Ligne).Delete
            End If
        Next i
    End With
End Sub

08/03/2013, 07h23
batiste39

La partie du filtre marche en effet mais pas la suppression, je ne vois dans le code où ça peut poser probleme.
Merci

Effectivement; modifie (il faut tester la colonne D) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Supprime()
    Dim i As Long
    Dim e As Long
    Dim A As String
    Dim Ligne As Long
    With Sheets("donnees_robots_lot1")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = Ligne To 6 Step -1
            If LCase(Cells(i, 4).Value) = "refusée" Or _
                LCase(Cells(i, 4).Value) = "relâchée non traite" Then
                Rows(i).Delete
            End If
        Next i
    End With
End Sub

08/03/2013, 22h36
batiste39

Merci ça marche nickel!