Excel VBA ne prend pas en compte mes criteres de filtrage et aucun message d'erreur

**coco.on.off** · 11/08/2014, 08h55

Bonjour,

J'ai cree un code pour filtrer des donnees et je n'ai aucun message d'erreur. Cependant il ne fait pas son travail car il ne prend pas en compte les criteres que je lui ai donne.
Voici mon code :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Private Sub CommandButton1_Click()
' Get a new revision number
 
    ActiveSheet.Unprotect
 
    a = Sheets("NEW REVISION").Range("C4")
    b = Sheets("NEW REVISION").Range("E4")
 
    Sheets("COMPLETE LIST").Visible = True
    Sheets("COMPLETE LIST").Select
    ActiveSheet.Unprotect
 
' Refresh complete list
 
    ActiveSheet.Range("C7").AutoFilter Field:=1
    ActiveSheet.Range("D7").AutoFilter Field:=2
    ActiveSheet.Range("E7").AutoFilter Field:=3
    ActiveSheet.Range("F7").AutoFilter Field:=4
    ActiveSheet.Range("G7").AutoFilter Field:=5
    ActiveSheet.Range("H7").AutoFilter Field:=6
 
' Filtering
 
    Sheets("COMPLETE LIST").Select
    Dim LastLig As Long
    Dim Plage As Range
 
    With Worksheets("COMPLETE LIST")
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        If LastLig >= 8 Then
            Set Plage = .Range("C8:FG" & LastLig)
            ' Suite de ton code concernant Plage (de type range)
            ActiveSheet.Range("C9:FG" & LastLig).Select
            Else
                Set Plage = Nothing
        End If
    End With
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    If a <> "" Then
        Selection.AutoFilter Field:=1, Criteria1:=a
        a = ""
    End If
 
    If b <> "" Then
        Selection.AutoFilter Field:=4, Criteria1:=b
        b = ""
    End If
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
End Sub

Le critere A etant du genre "T000" et le critere B etant du genre "AA". je demande a ma macro d'aller chercher ces criteres dans une autre page de travail.

Sauriez vous pourquoi il ne l'ai prend pas en compte ?

Amicalement

**had4789** · 11/08/2014, 09h33

Bonjour,

A mon humble avis le problème vient de là.

Code :

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

ActiveSheet.Unprotect

Juste par curiosité à quoi te servent les lignes

Code :

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

1
2
3
4
5
6
ActiveSheet.Range("C7").AutoFilter Field:=1
    ActiveSheet.Range("D7").AutoFilter Field:=2
    ActiveSheet.Range("E7").AutoFilter Field:=3
    ActiveSheet.Range("F7").AutoFilter Field:=4
    ActiveSheet.Range("G7").AutoFilter Field:=5
    ActiveSheet.Range("H7").AutoFilter Field:=6

**Stanler** · 11/08/2014, 09h33

Bonjour,

Voilà je code que j'ai pour rechercher un critère dans un filtre :

Code :

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

1
2
3
CRITERE= Application.InputBox("Quel est le critère recherché ?", "CRITERE ?", Type:=1)
    Sheets("Feuil1").Select
    ActiveSheet.ListObjects("MonTableauFiltré").Range.AutoFilter Field:=1, Criteria1:=CRITERE

Vous pouvez essayer de l'adapter à votre code ?

Cdlt,

**coco.on.off** · 11/08/2014, 09h44

Les lignes de codes :

Code :

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

ActiveSheet.Range("C7").AutoFilter Field:=1

me servent (comme indiquer en commentaire) a rafraichir ma liste complete.

euh non le probleme ne vient pas de

Code :

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

ActiveSheets.Unprotect

sinon j'aurai des problemes dans toutes les macro que j'utilise. C'est une simple ligne de code pour ne plus proteger la feuille.

Pour le code que tu m'as donne j'ai du mal a le comprendre (2eme personne a m'avoir repondu)

**Stanler** · 11/08/2014, 10h06

Coco.on.off,

Mon code affiche une input box, qui est une boite de dialogue avec une barre de saisie. Je demande à l'utilisateur de la macro de saisir le critère qui sera filtré dans la macro.

Est-il possible pour toi d'adapter mon code à ta macro ?

**coco.on.off** · 11/08/2014, 10h25

J'ai adapte ton code comme ceci :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Private Sub CommandButton1_Click()
' Get a new revision number
 
    'a = Sheets("NEW REVISION").Range("C4")
    'b = Sheets("NEW REVISION").Range("E4")
 
    Sheets("COMPLETE LIST").Visible = True
    Sheets("COMPLETE LIST").Select
    ActiveSheet.Unprotect
 
' Refresh complete list
 
    ActiveSheet.Range("C7").AutoFilter Field:=1
    ActiveSheet.Range("D7").AutoFilter Field:=2
    ActiveSheet.Range("E7").AutoFilter Field:=3
    ActiveSheet.Range("F7").AutoFilter Field:=4
    ActiveSheet.Range("G7").AutoFilter Field:=5
    ActiveSheet.Range("H7").AutoFilter Field:=6
 
' Filtering
 
    Sheets("COMPLETE LIST").Select
    Dim LastLig As Long
    Dim Plage As Range
 
    With Worksheets("COMPLETE LIST")
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        If LastLig >= 8 Then
            Set Plage = .Range("C9:FG" & LastLig)
            ' Suite de ton code concernant Plage (de type range)
            ActiveSheet.Range("C9:FG" & LastLig).Select
            Else
                Set Plage = Nothing
        End If
    End With
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    'If a <> "" Then
        'Selection.AutoFilter Field:=1, Criteria1:=a
        'a = ""
    'End If
 
    'If b <> "" Then
        'Selection.AutoFilter Field:=4, Criteria1:=b
        'b = ""
    'End If
 
    CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?", Type:=1)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?", Type:=1)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=4, Criteria1:=CRITERIA
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
End Sub

Quand j'execute mon code en debugage, et que je rentre mon premier critere dans la boite de dialogue, il me repond que mon numero n'est pas valide.
Il me met se message d'erreur pour la ligne 53

Amicalement

**Stanler** · 11/08/2014, 10h44

Essayes avec :

Code :

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

1
2
3
4
5
6
7
CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?", Type:=2)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?", Type:=2)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=4, Criteria1:=CRITERIA

Si tu as un message d'erreur, essayes avec :

Code :

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

1
2
3
4
5
6
7
CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?")
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?")
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=4, Criteria1:=CRITERIA

Si tu as encore un message d'erreur, tu peux essayer avec :

Code :

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

1
2
3
4
5
6
7
CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?", Type:=0)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?", Type:=0)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=4, Criteria1:=CRITERIA

Dis nous si ça fonctionne.

**coco.on.off** · 11/08/2014, 10h50

Il ne me remet plus le message d'erreur pour la ligne 53, il a du accepter le type 2 (ta premiere solution).
J'ai continue a debuger mon code et pour la ligne 54 il me sort un runtime error 9 : subscript out of range

**Stanler** · 11/08/2014, 11h15

Voici un topic qui traite de l'erreur que tu rencontres : http://www.developpez.net/forums/d65...-out-of-range/.

Pour le reste, ça dépasse largement mes maigres compétences. Il serait préférable d'attendre l'aide d'un autre membre du forum

**coco.on.off** · 12/08/2014, 09h40

Faut croire que pour le moment aucun membre, mise a part Stanler qui a tente, ne peut ne dire pourquoi ca fonctionne pas.

**had4789** · 12/08/2014, 10h24

Peut-être simplement parce que tu connais déjà la solution si tu cherches un minimum...

Tu dis:

Il ne me remet plus le message d'erreur pour la ligne 53, il a du accepter le type 2 (ta premiere solution).
J'ai continue a debuger mon code et pour la ligne 54 il me sort un runtime error 9 : subscript out of range

C'est donc soit une erreur de type, soit comme l'indique l'erreur que les valeurs que tu veux renvoyer ne sont pas au bonne endroit.

**Marc-L** · 12/08/2014, 11h15

Bonjour.

Envoyé par coco.on.off

Faut croire que pour le moment aucun membre, mise a part Stanler qui a tente, ne peut ne dire pourquoi ca fonctionne pas.

VBA effectuant toujours son travail, fiable à 99.99%, c'est donc quasiment à 100% une faute de conception du développeur ‼

Donc le B-A-BA lorsqu'il s'agit d'une fonction de feuilles de calculs est d'utiliser le Générateur de macros et
d'effectuer la manipulation manuellement puis de comparer avec le code généré …

Ne pas oublier non plus le mode pas à pas du VBE (environnement VBA) via la touche F8 permettant de suivre
la progression du code tout en vérifiant les variables dans la fenêtre des Variables locales
et si besoin les modifications au sein d'une feuille de calculs …

Consulter l'aide associée à un message d'erreur dirige souvent vers le chemin de la solution …

Encore une fois, travailler par sélection n'est pas recommandé, source d'erreurs récurrente …

La qualité de la présentation d'une problématique est essentielle : un texte rédigé à la va-vite, sans relecture évidente,
sans accent et bourré de fautes ne donne pas vraiment envie de répondre …

**coco.on.off** · 12/08/2014, 13h05

Je vous pris de bien vouloir m'excuser, je suis tout a fait d'accord avec toi Marc quant au fait que je ne me suis pas relus et qu'il y ai un tas de fautes et je m'en excuse. Pour ce qui est des accents, vous vous adresserez aux Anglais qui ont oublies de les mettre sur leurs claviers.

Lorsque je cree une macro j'utilise toujours le mode debugage (F8) avant de la lacher dans la nature. Ce que j'ai fait aussi pour celle-ci.

Etant donne que mon post est incomprehensible je vous le reformule :

Bonjour a tous,

Je vous pris de bien vouloir m'excuser pour toutes les fautes d'accentuation que je ferai, mais les anglais les ont oublies.

J'ai cree un code pour filtrer des donnees dans une liste complete de donnees (ma base de donnees). Ce filtre consiste a recuperer le dernier numero de revision d'un document afin de le mettre a jour. Afin de le recuperer, j'utilise le numero du moteur (T000) auquel le document est attache et le numero de l'ancienne revision du document.

Pour mieux comprendre mon probleme voici 2 photos :

Pièce jointe 153537

Cette photo illustre le fait que je voudrais faire une revision d'un Race Report (code de document RR) pour le moteur T072. Le bouton "Get Number" permet de lancer ma macro automatiquement sans passer pas la fenetre VBA. Ce que je n'ai pas encore fait puisque la macro ne fonctionne pas.

Pièce jointe 153541

Cette deuxieme photo a ete prise lors de l'execution pas a pas de ma macro depuis la fenetre VBA. Pour mieux la comprendre voici mon code sans changement par Stanler :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
 
Private Sub CommandButton1_Click()
' Get a new revision number
 
    a = Sheets("NEW REVISION").Range("C4")
    b = Sheets("NEW REVISION").Range("E4")
 
    Sheets("COMPLETE LIST").Visible = True
    Sheets("COMPLETE LIST").Select
    ActiveSheet.Unprotect
 
' Refresh complete list
 
    ActiveSheet.Range("C7").AutoFilter Field:=1
    ActiveSheet.Range("D7").AutoFilter Field:=2
    ActiveSheet.Range("E7").AutoFilter Field:=3
    ActiveSheet.Range("F7").AutoFilter Field:=4
    ActiveSheet.Range("G7").AutoFilter Field:=5
    ActiveSheet.Range("H7").AutoFilter Field:=6
 
' Filtering
 
    Dim LastLig As Long
    Dim Plage As Range
 
    With Worksheets("COMPLETE LIST")
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        If LastLig >= 8 Then
            Set Plage = .Range("C9:FG" & LastLig)
            ' Suite de ton code concernant Plage (de type range)
            ActiveSheet.Range("C9:FG" & LastLig).Select
            Else
                Set Plage = Nothing
        End If
    End With
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    If a <> "" Then
        Selection.AutoFilter Field:=1, Criteria1:=a
        a = ""
    End If
 
    If b <> "" Then
        Selection.AutoFilter Field:=4, Criteria1:=b
        b = ""
    End If
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
' Get item number :
 
    ActiveSheet.Range("G9").Copy
    Sheets("NEW REVISION").Select
    ActiveSheet.Range("Q3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("L7") = Range("Q3") + 1
 
    Sheets("COMPLETE LIST").Visible = False
    Sheets("NEW REVISION").Select

Avec le With, End With vous pouvez voir sur la deuxieme photo que ma plage de donnees non contigue a ete selectionnee entierement.
Lorsque j'execute pas a pas ce code, Excel ne detecte aucun probleme (message d'erreur) et pourtant l'oparation de filtrage dans les If, End If ne se fait pas. Du moins dans la liste complete le filtre n'a pas fonctionne.

D'ou mon poste.

Suite a la reponse de Stanler, J'ai modifie mon code comme ceci :

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Private Sub CommandButton1_Click()
' Get a new revision number
 
    Sheets("COMPLETE LIST").Visible = True
    Sheets("COMPLETE LIST").Select
    ActiveSheet.Unprotect
 
    ' Refresh complete list
    ActiveSheet.Range("C7").AutoFilter Field:=1
    ActiveSheet.Range("D7").AutoFilter Field:=2
    ActiveSheet.Range("E7").AutoFilter Field:=3
    ActiveSheet.Range("F7").AutoFilter Field:=4
    ActiveSheet.Range("G7").AutoFilter Field:=5
    ActiveSheet.Range("H7").AutoFilter Field:=6
 
    ' Filtering
    Sheets("COMPLETE LIST").Select
    Dim LastLig As Long
    Dim Plage As Range
 
    With Worksheets("COMPLETE LIST")
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
        If LastLig >= 8 Then
            Set Plage = .Range("C9:FG" & LastLig)
            ' Suite de ton code concernant Plage (de type range)
            ActiveSheet.Range("C9:FG" & LastLig).Select
            Else
                Set Plage = Nothing
        End If
    End With
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?,Type:=1+2")
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?", Type:=2)
    Sheets("COMPLETE LIST").Select
    ActiveSheet.ListObjects("Plage").Range.AutoFilter Field:=4, Criteria2:=CRITERIA
 
    Selection.Sort Key1:=ActiveSheet.Range("H9"), Order1:=xlDescending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
 
    ' Get revision number :
    ActiveSheet.Range("G9").Copy
    Sheets("NEW REVISION").Select
    ActiveSheet.Range("Q3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("L7") = Range("Q3") + 1
 
    Sheets("COMPLETE LIST").Visible = False
    Sheets("FILTERED LIST").Visible = False
    Sheets("NEW REVISION").Select

L'InputBox fonctionne pour le premier, j'ai pu rentre le numero d'un moteur (existant dans ma base de donnees). Lorsque je fait entrer a la ligne qui filtre, un message d'erreur s'affiche : runtime error 9 subscript out of range.

Les 3 lignes de code avec l'InputBox peuvent etre remplacees par ce code ci :

Code :

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

1
2
3
4
5
6
 
    CRITERIA = Application.InputBox("Sought Engine ?", "CRITERIA ?,Type:=1+2")
    Sheets("COMPLETE LIST").ListObjects("Plage").Range.AutoFilter Field:=1, Criteria1:=CRITERIA
 
    CRITERIA = Application.InputBox("Sought Document ?", "CRITERIA ?", Type:=2)
    Sheets("COMPLETE LIST").ListObjects("Plage").Range.AutoFilter Field:=4, Criteria2:=CRITERIA

Meme sans le .Select j'ai le meme message.
Je me suis dit qu'il y avait peut etre un probleme avec le mot "Plage".

J'espere que ce poste est assez detaille, s'il ne l'est pas je suis toute oui pour rajouter des informations.

Amicalement.

**Theze** · 12/08/2014, 14h11

Bonjour,

J'ai épuré ton code alors teste pour voir et adapte sinon, un fichier exemple :

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
 
Private Sub CommandButton1_Click()
 
    Dim LastLig As Long
    Dim Plage As Range
    Dim A As String
    Dim B As String
 
    With Sheets("NEW REVISION")
 
        .Unprotect
 
        'critères
        A = .Range("C4")
        B = .Range("E4")
 
    End With
 
    With Sheets("COMPLETE LIST")
 
        .Visible = True
        .Unprotect
 
        LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
 
        'si inférieur ou égal aux 8 premières lignes, fin
        If LastLig <= 8 Then Exit Sub
 
        Set Plage = .Range("C9:FG" & LastLig)
 
    End With
 
    'filtrage sur la colonne 1 de la plage (C)
    If A <> "" Then Plage.AutoFilter 1, A
 
    'filtrage sur la colonne 4 de la plage (F)
    If B <> "" Then Plage.AutoFilter 4, B
 
End Sub

Hervé.

Excel VBA ne prend pas en compte mes criteres de filtrage et aucun message d'erreur

Macros et VBA Excel

Discussions similaires

Partager

Partager