Discussion :

[nananinanana]

Bonjour la communauté !

J'essaie de mettre en place une exctraction avec un filtre élaboré multicritère provenant d'une listbox et de 2 dates mais ça coince !

Notamment ligne 19 (et donc j'imagine 38) ou un message d'erreur s'affiche !

il doit très certainement y avoir une erreur dans mon raisonnement. J'ai déjà regardé sur les différents tuto mais je bloque si quelqu'un pouvait débloquer ?

Merci d'avance

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
rivate Sub CommandButton1_Click()
Dim Tablo()
Dim I As Integer, Indice As Integer
Dim DerL%
DerL = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
 
  With Me.ListBox1
    For I = 0 To .ListCount - 1
      If .Selected(I) = True Then
        ReDim Preserve Tablo(Indice)
        Tablo(Indice) = .List(I)
        Indice = Indice + 1
      End If
    Next I
  End With
  If Indice = 0 Then
    Worksheets("data").Range("H2:H" & DerL).AutoFilter Field:=8
  Else
    Worksheets("data").Range("H2:H" & DerL).AdvancedFilter _
    Action:=xlFilterCopy, _
    Criteria1:=Tablo(), _
    CopyToRange:=Worksheets("extract").Range("A2:M" & DerL), _
    Unique:=False
  End If
 
   With Me.ListBox2
    For I = 0 To .ListCount - 1
      If .Selected(I) = True Then
        ReDim Preserve Tablo(Indice)
        Tablo(Indice) = .List(I)
        Indice = Indice + 1
      End If
    Next I
  End With
  If Indice = 0 Then
    Worksheets("data").Range("F2:F" & DerL).AutoFilter Field:=6
  Else
    Worksheets("data").Range("F2:F" & DerL).AdvancedFilter _
    Action:=xlFilterCopy, _
    Criteria1:=Tablo(), _
    CopyToRange:=Worksheets("extract").Range("A2:M" & DerL), _
    Unique:=False
  End If
raz
End Sub
 
Private Sub CommandButton2_Click()
  For I = 0 To Me.ListBox1.ListCount - 1: Me.ListBox1.Selected(I) = False: Next
  For I = 0 To Me.ListBox2.ListCount - 1: Me.ListBox2.Selected(I) = False: Next
  Me.DTPicker1 = False
  Me.DTPicker2 = False
  raz
End Sub
 
Private Sub UserForm_Initialize()
    Dim Cell1 As Range, Cell2 As Range
    Dim Unique1 As New Collection, Unique2 As New Collection
    Dim Valeur1 As Range, Valeur2 As Range
    Dim I As Integer
 
    'Récupère la derniere ligne non vide dans la colonne A
    I = Worksheets("Data").Range("A65536").End(xlUp).Row
 
    On Error Resume Next
    'boucle sur les Cell1ules de la colonne A
    For Each Cell1 In Worksheets("Data").Range("H2:H" & I)
        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        If Cell1 <> "" Then
        Unique1.Add Cell1, CStr(Cell1)
        End If
    Next Cell1
    On Error GoTo 0
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur1 In Unique1
        Me.ListBox1.AddItem Valeur1
        Me.ListBox1.MultiSelect = fmMultiSelectMulti
    Next Valeur1
 
    On Error Resume Next
    For Each Cell2 In Worksheets("Data").Range("F2:F" & I)
        'Stocke les données dans une collection
        '(La collection n'accepte que des données uniques et permet donc
        ' de filtrer facilement les doublons).
        If Cell2 <> "" Then
        Unique2.Add Cell2, CStr(Cell2)
        End If
    Next Cell2
    On Error GoTo 0
    'Boucle sur le contenu de la collection pour alimenter la ListBox
    For Each Valeur2 In Unique2
        Me.ListBox2.AddItem Valeur2
        Me.ListBox2.MultiSelect = fmMultiSelectMulti
    Next Valeur2
 
End Sub

[EBRAG]

Bonjour,

ce que je perçois...

dans le Criteria je vois Tablo()

Sauf erreur de ma part, il devrait y avoir un objet range à cet endroit, avec en première ligne les titres de champs en critères et au-dessous lles critères eux-mêmes.

[Theze]

Bonjour,

As-tu fais une boucle sur ton tableau pour voir ce qu'il contient ?

Code :

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

1
2
3
4
5
6
 
For I = 0 To UBound(Tablo)
 
    Debug.Print Tablo(I)
 
Next I

As-tu fait un test avec seulement le premier filtrage ?
Sinon, en indiquant seulement la cellule en haut à gauche de la plage devant recevoir le résultat du filtre ?

Code :

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

1
2
 
Worksheets("extract").Range("A2")

Je vois que tu ne réinitialises pas ton tableau entre les deux filtrages, c'est normal ? Les valeurs du tableau doivent être de même nature.
Je ne peux pas tester car difficile de créer tes conditions. Si tu n'y arrives pas, poste un classeur 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
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
66
67
68
 
Private Sub CommandButton1_Click()
 
    Dim Plage As Range
    Dim Tablo()
    Dim I As Integer, Indice As Integer
    Dim DerL%
 
    DerL = Worksheets("data").Cells(Rows.Count, 1).End(xlUp).Row
 
    Set Plage = Worksheets("data").Range("H2:H" & DerL)
 
    With Me.ListBox1
 
        For I = 0 To .ListCount - 1
 
            If .Selected(I) = True Then
 
                ReDim Preserve Tablo(Indice)
                Tablo(Indice) = .List(I)
                Indice = Indice + 1
 
            End If
 
        Next I
 
    End With
 
    If Indice = 0 Then
 
        Plage.AutoFilter 8
 
    Else
 
        Plage.AdvancedFilter 2, Tablo(), Worksheets("extract").Range("A2"), False
 
    End If
 
    With Me.ListBox2
 
        For I = 0 To .ListCount - 1
 
            If .Selected(I) = True Then
 
                ReDim Preserve Tablo(Indice)
                Tablo(Indice) = .List(I)
                Indice = Indice + 1
 
            End If
        Next I
 
    End With
 
    Set Plage = Worksheets("data").Range("F2:F" & DerL)
 
    If Indice = 0 Then
 
        Plage.AutoFilter 6
 
    Else
 
        Plage.AdvancedFilter 2, Tablo(), Worksheets("extract").Range("A2"), False
 
    End If
 
    raz
 
End Sub

[nananinanana]

Je n'ai pas réinitialiser mes tableaux car je souhaite pour filtrer avec plusieurs conditions, la réinitialisation de ceux-ni ne risque pas de m'empêcher cela ?

Ci joint le fichier, j'ai crée la feuille extract pour tester mais c'est la feuille "convocation" que je souhaiterais renseigner

Convoc.xlsx

[Theze]

Bonjour,

Sans le formulaire difficile de tester !
Poste ton .xlsm