Chercher la valeur d'une variable en fonction des valeurs de plusieurs variables

Version imprimable

1 pièce(s) jointe(s)

Bonjour ,
j'ai ma situation est la suivante :

colonne 1 : variable typalim;
colonne 2 : variable modecon;
colonne 3 : variable typf;
colonne 4: variable esp;
colonne 5: variable cycl;
colonne 6: variable appstad;
colonne 7: variable stad.

Je souhaite chercher la valeur correspondante à la colonne "EN" selon les valeurs que prennent les variables déjà citer j'ai utilisé les code suivant :

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
Option Explicit
Dim typalim As String
Dim modecon As String
Dim typf As String
Dim esp As String
Dim cycl As String
Dim appstad As String
Dim stad As String
Dim stadtyp As String
Dim ENT As Single
Sub CommandButton1_Click()
typalim = ComboBox1.Value
modecon = ComboBox2.Value
typf = ComboBox3.Value
esp = ComboBox4.Value
cycl = ComboBox5.Value
appstad = ComboBox6.Value
stad = ComboBox7.Value
Dim rngData As Range, rngLabelRow1 As Range, rngLabelRow2 As Range, rngLabelRow3 As Range, rngLabelRow4 As Range, rngLabelRow5 As Range, rngLabelRow6 As Range, rngLabelRow7 As Range, rngLabelColumn As Range, fn As WorksheetFunction
Set fn = Application.WorksheetFunction
With ThisWorkbook1.Worksheets("Feuil2")
Set rngData = .Range("H2:O70")
Set rngLabelRow1 = .Range("A2:A70")
Set rngLabelRow2 = .Range("B2:B70")
'Set rngLabelRow3 = .Range("C2:C70")
'Set rngLabelRow4 = .Range("D2:D70")
'Set rngLabelRow5 = .Range("E2:E70")
'Set rngLabelRow6 = .Range("F2:F70")
'Set rngLabelRow7 = .Range("G2:G70")
Set rngLabelColumn = .Range("H1:O1")
End With
With fn
ENT = .Index(rngData, .Match(typalim, rngLabelRow1, 0), .Match(modecon, rngLabelRow2, 0), .Match("EN", rngLabelColumn, 0))
'ENT = .Index(rngData, .Match(typalim, rngLabelRow1, 0), .Match(modecon, rngLabelRow2, 0), .Match(typf, rngLabelRow7, 0), .Match(esp, rngLabelRow3, 0), .Match(cycl, rngLabelRow4, 0), .Match(appstad, rngLabelRow5, 0), .Match(stad, rngLabelRow6, 0), .Match("EN", rngLabelColumn, 0))
End With
End Sub

Par ailleurs la fonction n'admet pas plus que 4 arguments donc comment je peux résoudre ce problème. Mon fichier en pièce jointe
Pièce jointe 169381

Merci d'avance !!:D

Bonjour,

Voici un exemple de code. A toi d'optimiser.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub UserForm_Initialize()
    Dim Feuille As String
 
    Feuille = "Feuil2"
 
    If (Sheets(Feuille).AutoFilterMode = False) Then
        Sheets(Feuille).Cells.AutoFilter
    Else
        Sheets(Feuille).Cells.AutoFilter
        Sheets(Feuille).Cells.AutoFilter
    End If
 
 
    Set Ws = Worksheets("Feuil2")
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    Alim_Combo 1
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
 
    Dim Feuille As String
    Feuille = "Feuil2"
    Sheets(Feuille).Cells.AutoFilter Field:=1, Criteria1:=ComboBox1.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=2, Criteria1:=ComboBox2.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=3, Criteria1:=ComboBox3.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=4, Criteria1:=ComboBox4.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=5, Criteria1:=ComboBox5.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=6, Criteria1:=ComboBox6.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=7, Criteria1:=ComboBox7.Value, Operator:=xlFilterValues

Bonne continuation.

1 pièce(s) jointe(s)

Bonjour

Merci beaucoup OBO29 , le problème c'est que je suis novice en matière de programmation , j'ai adopté votre code mais je sais pas comment trouver la valeur de "EN" et l'affecter à la variable ENT (pièce jointe ). d'autre part lorsque je souhaite refaire la sélection le programme sauvegarde le dernier tableau (la fameuse ligne filtrée)?

Votre aide SVP Pièce jointe 169407

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
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
Option Explicit
'Définition des variables
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim typalim As String
Dim modecon As String
Dim typf As String
Dim esp As String
Dim cycl As String
Dim appstad As String
Dim stad As String
Dim stadtyp As String
Dim ENT As Single
Dim Feuille As String
'ComboBox en cascade
Private Sub ComboBox7_Change()
End Sub
Private Sub UserForm_Initialize()
    Set Ws = Worksheets("Feuil2")
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    Alim_Combo 1
End Sub
Private Sub ComboBox1_Change()
    Alim_Combo 2, ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()
    Alim_Combo 3, ComboBox2.Value
End Sub
Private Sub ComboBox3_Change()
    Alim_Combo 4, ComboBox3.Value
End Sub
Private Sub ComboBox4_Change()
    Alim_Combo 5, ComboBox4.Value
End Sub
 
Private Sub ComboBox5_Change()
    Alim_Combo 6, ComboBox5.Value
End Sub
Private Sub ComboBox6_Change()
    Alim_Combo 7, ComboBox6.Value
End Sub
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
    Dim j As Integer
    Dim Obj As Control
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    Obj.Clear
    If CbxIndex = 1 Then
        For j = 2 To NbLignes
            Obj = Ws.Range("A" & j)
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j)
        Next j
    Else
        For j = 2 To NbLignes
            If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = Cible Then
                Obj = Ws.Range("A" & j).Offset(0, CbxIndex - 1)
                If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j).Offset(0, CbxIndex - 1)
            End If
        Next j
   End If
   Obj.ListIndex = -1
End Sub
 
'Chercher la valeur d'une variable en fonction des valeurs de plusieurs variables
 
Sub CommandButton1_Click()
 
typalim = ComboBox1.Value
modecon = ComboBox2.Value
typf = ComboBox3.Value
esp = ComboBox4.Value
cycl = ComboBox5.Value
appstad = ComboBox6.Value
stad = ComboBox7.Value
 
    Dim Feuille As String
 
    Feuille = "Feuil2"
    If (Sheets(Feuille).AutoFilterMode = False) Then
        Sheets(Feuille).Cells.AutoFilter
    Else
        Sheets(Feuille).Cells.AutoFilter
        Sheets(Feuille).Cells.AutoFilter
End If
    Feuille = "Feuil2"
    Sheets(Feuille).Cells.AutoFilter Field:=1, Criteria1:=ComboBox1.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=2, Criteria1:=ComboBox2.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=3, Criteria1:=ComboBox3.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=4, Criteria1:=ComboBox4.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=5, Criteria1:=ComboBox5.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=6, Criteria1:=ComboBox6.Value, Operator:=xlFilterValues
    Sheets(Feuille).Cells.AutoFilter Field:=7, Criteria1:=ComboBox7.Value, Operator:=xlFilterValues
End Sub

19/02/2015, 09h16
Aposto

Bonjour à tous,

Pour récupérer les lignes filtrées, il faut que tu utilises la fonction specialcells, avec l'argument xlcelltypevisible

une ligne de code possible serait pour toi:

Code:

ENT=sheets("feuille2").Columns(12).SpecialCells(xlCellTypeVisible).End(xlDown).Value

Pour supprimer le filtre:

Code:

sheets("feuille2").showalldata

voilà voilà
19/02/2015, 13h04
Hadi2015
Bonjour,

Je le code marche très très bien :yaisse2::yaisse2: je vous remercie infiniment, j'ai une dernière question , je souhaite mettre une condition sur l'instruction
Code:

1 2 3 Private Sub CommandButton2_Click() Sheets("Feuil2").ShowAllData End Sub
Lorsque je clique deux fois elle provienne une erreur , donc est ce qu'il y a une technique par laquelle lorsque l'instruction est vérifiée je passe à

Code:

Unload UserForm2

Je vous remercie encore une fois

1 pièce(s) jointe(s)

un autre problème avec mon code

:help::furieux:

Bonjour , une chose bizarre le code marche uniquement pour le premier choix offert par mon combobox , si je réalise un autre choix la valeur de la colonne 12 est 0 ??!!

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
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
98
99
100
101
102
103
104
105
106
107
Option Explicit
'Définition des variables
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim typalim As String
Dim modecon As String
Dim typf As String
Dim esp As String
Dim cycl As String
Dim appstad As String
Dim stad As String
Dim stadtyp As String
Dim ENT As Single
Dim AZOT As Single
Dim MINX As Single
Dim P As Single
Dim CA As Single
 
'ComboBox en cascade
 
 
Private Sub UserForm_Initialize()
    Set Ws = Worksheets("Feuil2")
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    Alim_Combo 1
End Sub
Private Sub ComboBox1_Change()
    Alim_Combo 2, ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()
    Alim_Combo 3, ComboBox2.Value
End Sub
Private Sub ComboBox3_Change()
    Alim_Combo 4, ComboBox3.Value
End Sub
Private Sub ComboBox4_Change()
    Alim_Combo 5, ComboBox4.Value
End Sub
 
Private Sub ComboBox5_Change()
    Alim_Combo 6, ComboBox5.Value
End Sub
Private Sub ComboBox6_Change()
    Alim_Combo 7, ComboBox6.Value
End Sub
 
Private Sub ComboBox7_Change()
End Sub
 
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
    Dim j As Integer
    Dim Obj As Control
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    Obj.Clear
    If CbxIndex = 1 Then
        For j = 2 To NbLignes
            Obj = Ws.Range("A" & j)
            If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j)
        Next j
    Else
        For j = 2 To NbLignes
            If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = Cible Then
                Obj = Ws.Range("A" & j).Offset(0, CbxIndex - 1)
                If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j).Offset(0, CbxIndex - 1)
            End If
        Next j
   End If
   Obj.ListIndex = -1
End Sub
 
'Chercher la valeur d'une variable en fonction des valeurs de plusieurs variables
 
Sub CommandButton1_Click()
 
typalim = ComboBox1.Value
modecon = ComboBox2.Value
typf = ComboBox3.Value
esp = ComboBox4.Value
cycl = ComboBox5.Value
appstad = ComboBox6.Value
stad = ComboBox7.Value
 
 Dim Feuille As String
    Feuille = "Feuil2"
    If (Sheets(Feuille).AutoFilterMode = False) Then
        Sheets(Feuille).Cells.AutoFilter
    Else
        Sheets(Feuille).Cells.AutoFilter
        Sheets(Feuille).Cells.AutoFilter
End If
 
Feuille = "Feuil2"
Sheets(Feuille).Cells.AutoFilter Field:=1, Criteria1:=ComboBox1.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=2, Criteria1:=ComboBox2.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=3, Criteria1:=ComboBox3.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=4, Criteria1:=ComboBox4.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=5, Criteria1:=ComboBox5.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=6, Criteria1:=ComboBox6.Value, Operator:=xlFilterValues
Sheets(Feuille).Cells.AutoFilter Field:=7, Criteria1:=ComboBox7.Value, Operator:=xlFilterValues
 
ENT = Sheets("Feuil2").Columns(12).SpecialCells(xlCellTypeVisible).End(xlDown).Value
Range("A1").Select
Selection.Value = ENT
End Sub
Private Sub CommandButton2_Click()
Sheets("Feuil2").ShowAllData
End Sub

pour tester jai mis en pièce jointe mon fichier :Pièce jointe 169494

Merci beaucoup!

19/02/2015, 19h27
Hadi2015

Bonjour ,
Après vérification le code marche bien j'ai un problème dans ma base de données !
Merci beaucoup à vous tous !!

Bonjour,

Voici quelques suggestions ; teste le c'est bien plus rapide.
Il reste encore bcp d'optimisations possibles, mais ça fonctionne bien.

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
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
 
Option Explicit
'Définition des variables
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim typalim As String
Dim modecon As String
Dim typf As String
Dim esp As String
Dim cycl As String
Dim appstad As String
Dim stad As String
Dim stadtyp As String
Dim ENT As Single
Dim AZOT As Single
Dim MINX As Single
Dim P As Single
Dim CA As Single
Private Stop_event As Boolean
 
'ComboBox en cascade
Private Sub UserForm_Initialize()
    Set Ws = Worksheets("Feuil2")
    NbLignes = Ws.Range("A65536").End(xlUp).Row
    ' Retrait du filtre automatique
    If (Ws.AutoFilterMode = True) Then
        Ws.Cells.AutoFilter
    End If
    'Autoriser les évenements combo
    Stop_event = False
    'Init combo1
    Alim_Combo 1
End Sub
Private Sub ComboBox1_Change()
    If Not Stop_event Then Alim_Combo 2, ComboBox1.Value
End Sub
Private Sub ComboBox2_Change()
    If Not Stop_event Then Alim_Combo 3, ComboBox2.Value
End Sub
Private Sub ComboBox3_Change()
    If Not Stop_event Then Alim_Combo 4, ComboBox3.Value
End Sub
Private Sub ComboBox4_Change()
    If Not Stop_event Then Alim_Combo 5, ComboBox4.Value
End Sub
Private Sub ComboBox5_Change()
    If Not Stop_event Then Alim_Combo 6, ComboBox5.Value
End Sub
Private Sub ComboBox6_Change()
    If Not Stop_event Then Alim_Combo 7, ComboBox6.Value
End Sub
Private Sub ComboBox7_Change()
    Dim Obj_Test As Control, Boucle As Integer
 
    If Not Stop_event Then
        ' Mise en place du filtre automatique
        If (Ws.AutoFilterMode = False) Then
            Ws.Cells.AutoFilter
        Else
            Ws.Cells.AutoFilter
            Ws.Cells.AutoFilter
        End If
        'Filtrage suivant combos
        For Boucle = 1 To 7
            Set Obj_Test = Me.Controls("ComboBox" & Boucle)
            Ws.Cells.AutoFilter Field:=Boucle, Criteria1:=Obj_Test.Value, Operator:=xlFilterValues
        Next Boucle
        'Recherche du résultat
        ENT = Sheets("Feuil2").Columns(12).SpecialCells(xlCellTypeVisible).End(xlDown).Value
        Range("A1").Select
        Selection.Value = ENT
         'Retire le filtre automatique
        Ws.Cells.AutoFilter
    End If
 
End Sub
 
Private Sub Alim_Combo(CbxIndex As Integer, Optional Cible As Variant)
    Dim j As Integer, flag As Boolean, Boucle_Test As Integer
    Dim Obj As Control, Obj_Test As Control
    Set Obj = Me.Controls("ComboBox" & CbxIndex)
    Obj.Clear
 
    Stop_event = True   'Permet d'éviter les "bouclages" inutiles et donnant un programme lourd et lent.
 
    If CbxIndex = 1 Then
        For j = 2 To NbLignes
            Obj = Ws.Range("A" & j)
            If Obj.ListIndex = -1 Then
                Obj.AddItem Ws.Range("A" & j)
            End If
        Next j
    Else
        For j = 2 To NbLignes
            'Boucle de test de correspondance colonne/combo par rapport à TOUS les combos
            flag = False
            For Boucle_Test = 2 To CbxIndex
                Set Obj_Test = Me.Controls("ComboBox" & Boucle_Test - 1)
                If Ws.Range("A" & j).Offset(0, Boucle_Test - 2) <> Obj_Test.Value Then
                    flag = True
                    Exit For    'Test échoue; exit; vers test ligne suivante
                End If
            Next Boucle_Test
            If flag = False Then    'Si le test est réussi, alors on  prend la valeur
                If Ws.Range("A" & j).Offset(0, CbxIndex - 2) = Cible Then
                    Obj = Ws.Range("A" & j).Offset(0, CbxIndex - 1)
                    If Obj.ListIndex = -1 Then Obj.AddItem Ws.Range("A" & j).Offset(0, CbxIndex - 1)
                End If
            End If
        Next j
   End If
   Obj.ListIndex = -1
   Stop_event = False 'Ecoute à nouveau les évenements combos
End Sub

Bonne continuation :mouarf:

20/02/2015, 01h28
Hadi2015

Bonjour

Waww :):D OBO29 c'est très rapide je vous remercie beaucoup c'est très gentil de votre part!!