Discussion :

[batiste39]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Daniel.C]

Bonjour,

Essaie comme ceci (non testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[batiste39]

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

[Daniel.C]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[batiste39]

Merci ça marche nickel!