Code de recherche avec plusieurs conditions

Version imprimable

Voir 40 message(s) de cette discussion en une page

05/06/2020, 21h29
78chris

Bonjour à tous

Tu as quelle version Excel ?

Ton tableau de choix de critère peut porter sur n'importe quels critères : le code article peut se combiner à un ou plusieurs autres critères ?
05/06/2020, 23h12
alidroos

Citation:

Tu as quelle version Excel ?

Office 2007

Citation:

Ton tableau de choix de critère peut porter sur n'importe quels critères : le code article peut se combiner à un ou plusieurs autres critères ?

Les articles peuvent figurer sur plusieurs factures
05/06/2020, 23h55
78chris

RE

Ma question concerne les autres colonnes de ta plage A1:H6

A priori rien n'empêche de saisir des critères dans les autres colonnes que Numéro d'article et dans ce cas que fait-on ?
06/06/2020, 01h19
alidroos

L'intelligence artificielle est nécessaire pour deviner les numéros de facturation
L'historique peut être utilisé pour approximer les résultats
Mais je voulais rechercher des numéros de facturation avec des numéros d'articles spécifiques
Ceci est à ma disposition dans un programme de comptabilité via Oracle. Je voulais y accéder via Excel
Sachant qu'Excel est un possible analyste de données il en résulte facilement. Je manque de connaissances
06/06/2020, 01h21
alidroos

Citation:

Ma question concerne les autres colonnes de ta plage A1:H6

Le filtrage initial a été utilisé au début mais nous n'avons pas d'autres conditions que les numéros d'article
06/06/2020, 08h41
78chris

1 pièce(s) jointe(s)
Bonjour

Depuis 17 ans que les tableaux structurés existent et qu'on se passer depuis 13 ans des vieilles lunes du type

Code:

Range("A65536").End(xlUp).Row

https://fauconnier.developpez.com/tu...ux-structures/

J'ai mis
- ta plage de choix des articles sous forme de tableau nommé Choix
- ta plage de données sous forme de tableau nommé Donnees
et créé une procédure Filtrer pour sélectionner les factures qui contiennent l'ensemble des articles choisis

Avec 2010 et l'add on PowerQuery (intégré à Excel à partir de 2016) on pourrait faire plus simple que VBA...

PowerQuery pourrait même se connecter à la base Oracle
06/06/2020, 12h28
alidroos

Génial 78chris :ccool:
Comme première expérience un travail puissant
Je vous félicite d'avoir créé cette merveilleuse symphonie :king:
06/06/2020, 13h17
alidroos

J'espère une explication simplifiée du code que j'ai essayé de comprendre
mais c'est au dessus de mon niveau de connaissance
Merci du fond du cœur 78chris

Bonjour

Comme je l'ai dit, j'ai mis

ta plage de choix des articles sous forme de tableau nommé Choix
ta plage de données sous forme de tableau nommé Donnees

Pour le code, en le documentant, j'ai vu que je n'avais pas prévu le cas où il y a plusieurs factures ayant ces codes articles et te joins la version modifiée et commentée

on utilise deux tableaux (array) pour travailler en mémoire ce qui est plus rapide que des boucle sur la feuille : LChoix pour les articles choisis et Tablo pour les donnees
un array Criteres est utilisé pour récupérer les éléments Facture et Numéro article et construire les filtres sur les 2 colonnes
on peut se référer aux tableaux structurés soit par [Nom_du_tableau].ListObject soit par Range("Nom_du_Tableau").ListObject
Pour une raison que je ne m'explique pas ici, la 1ère solution, plus courte, ne fonctionne pas pour le tableau Choix alors qu'elle fonctionne pour Donnees
un tableau structué, ListObject en VBA, a, ce qui le rend facile à manipuler en VBA, :

un Range qui inclue toutes ses lignes dont le titre et la ligne de totaux,
un Databodyrange qui n'inclue que les lignes de données
des ListColumns et des ListRows
Nb récupère le nombre de lignes remplies de Choix
LChoix récupère ces Nb valeurs via un resize du DataBodyRange et Tablo les lignes de Donnees
Ensuite une boucle passe en revue chaque ligne de Tablo et compare son code article via une seconde boucle avec chacun des éléments de LChoix et met soit 1, soit 0, dans la 1ère colonne de Tablo et sort de la seconde boucle si 1
Toutes les lignes dont l'article correspond à un des choix a donc un 1 à la fin de la boucle principale
On refait une double boucle sur Tablo pour vérifier si les lignes qui ont 1 en 1ère colonne partagent le même numéro de facture et, si oui, ont ajoute 1 à la valeur de la 1ère colonne ce qui va donner 1 ou 2 ou 3 (Nb) à la fin
Si on a atteint Nb, on remplit le tableau Criteres et on écourte la seconde boucle
On utilise le tableau Criteres pour filtrer la colonne facture
On réinitialise Criteres et une boucle le remplit à partir de LChoix pour construire la liste du critère portant sur la colonne Numéro article
On applique le filtre
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 Sub Filtrer() Dim Tablo() Dim LChoix() Dim Criteres() Dim Nb As Integer, i As Long, J As Long, k As Long 'Nombre de Numéro d'article choisis Nb = WorksheetFunction.CountA(Range("Choix").ListObject.ListColumns(1).DataBodyRange) 'Remplissage de l'array LChoix depuis la partie remplie du tableau Choix LChoix = Range("Choix").ListObject.ListColumns(1).DataBodyRange.Resize(Nb, 1) 'Remplissage de l'array Tablo depuis le tableau Donnees Tablo = Range("Donnees").ListObject.DataBodyRange 'Repérage des lignes ayant un des Numéro d'article choisis For i = 1 To UBound(Tablo) For J = 1 To Nb If Tablo(i, 3) = LChoix(J, 1) Then Tablo(i, 1) = 1: Exit For Else Tablo(i, 1) = 0 Next J Next i 'Repérage des lignes déjà repérées partageant une même Facture + Préparation filtre Facture ReDim Criteres(1 To UBound(Tablo)) k = 1 For i = 1 To UBound(Tablo) If Tablo(i, 1) = 1 Then For J = 1 To UBound(Tablo) If Tablo(i, 8) = Tablo(J, 8) And J <> i And Tablo(J, 1) >= 1 Then Tablo(i, 1) = Tablo(i, 1) + 1 If Tablo(i, 1) = Nb Then 'Préparation filtre Facture Criteres(k) = Tablo(i, 8) & "": k = k + 1 Exit For End If Next J End If Next i 'Filtre Facture [Donnees].ListObject.Range.AutoFilter Field:=8, Criteria1:=Criteres, Operator:=xlFilterValues 'Filtre Article ReDim Criteres(1 To Nb) For i = 1 To Nb Criteres(i) = LChoix(i, 1) & "" Next i [Donnees].ListObject.Range.AutoFilter Field:=3, Criteria1:=Criteres, Operator:=xlFilterValues End Sub

07/06/2020, 23h07
alidroos

L'ajustement est exactement ce que je veux

Solution merveilleuse et brève

Merci beaucoup professeur 78chris :merci:
07/06/2020, 23h35
alidroos

2 pièce(s) jointe(s)

Un message d'erreur apparaît via le filtrage des factures

Est-ce dû à des numéros de facture en double

Citation:
Envoyé par 78chris
Bonjour

Comme je l'ai dit, j'ai mis

ta plage de choix des articles sous forme de tableau nommé Choix
ta plage de données sous forme de tableau nommé Donnees

Pour le code, en le documentant, j'ai vu que je n'avais pas prévu le cas où il y a plusieurs factures ayant ces codes articles et te joins la version modifiée et commentée

on utilise deux tableaux (array) pour travailler en mémoire ce qui est plus rapide que des boucle sur la feuille : LChoix pour les articles choisis et Tablo pour les donnees
un array Criteres est utilisé pour récupérer les éléments Facture et Numéro article et construire les filtres sur les 2 colonnes
on peut se référer aux tableaux structurés soit par [Nom_du_tableau].ListObject soit par Range("Nom_du_Tableau").ListObject
Pour une raison que je ne m'explique pas ici, la 1ère solution, plus courte, ne fonctionne pas pour le tableau Choix alors qu'elle fonctionne pour Donnees
un tableau structué, ListObject en VBA, a, ce qui le rend facile à manipuler en VBA, :

un Range qui inclue toutes ses lignes dont le titre et la ligne de totaux,
un Databodyrange qui n'inclue que les lignes de données
des ListColumns et des ListRows
Nb récupère le nombre de lignes remplies de Choix
LChoix récupère ces Nb valeurs via un resize du DataBodyRange et Tablo les lignes de Donnees
Ensuite une boucle passe en revue chaque ligne de Tablo et compare son code article via une seconde boucle avec chacun des éléments de LChoix et met soit 1, soit 0, dans la 1ère colonne de Tablo et sort de la seconde boucle si 1
Toutes les lignes dont l'article correspond à un des choix a donc un 1 à la fin de la boucle principale
On refait une double boucle sur Tablo pour vérifier si les lignes qui ont 1 en 1ère colonne partagent le même numéro de facture et, si oui, ont ajoute 1 à la valeur de la 1ère colonne ce qui va donner 1 ou 2 ou 3 (Nb) à la fin
Si on a atteint Nb, on remplit le tableau Criteres et on écourte la seconde boucle
On utilise le tableau Criteres pour filtrer la colonne facture
On réinitialise Criteres et une boucle le remplit à partir de LChoix pour construire la liste du critère portant sur la colonne Numéro article
On applique le filtre
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 Sub Filtrer() Dim Tablo() Dim LChoix() Dim Criteres() Dim Nb As Integer, i As Long, J As Long, k As Long 'Nombre de Numéro d'article choisis Nb = WorksheetFunction.CountA(Range("Choix").ListObject.ListColumns(1).DataBodyRange) 'Remplissage de l'array LChoix depuis la partie remplie du tableau Choix LChoix = Range("Choix").ListObject.ListColumns(1).DataBodyRange.Resize(Nb, 1) 'Remplissage de l'array Tablo depuis le tableau Donnees Tablo = Range("Donnees").ListObject.DataBodyRange 'Repérage des lignes ayant un des Numéro d'article choisis For i = 1 To UBound(Tablo) For J = 1 To Nb If Tablo(i, 3) = LChoix(J, 1) Then Tablo(i, 1) = 1: Exit For Else Tablo(i, 1) = 0 Next J Next i 'Repérage des lignes déjà repérées partageant une même Facture + Préparation filtre Facture ReDim Criteres(1 To UBound(Tablo)) k = 1 For i = 1 To UBound(Tablo) If Tablo(i, 1) = 1 Then For J = 1 To UBound(Tablo) If Tablo(i, 8) = Tablo(J, 8) And J <> i And Tablo(J, 1) >= 1 Then Tablo(i, 1) = Tablo(i, 1) + 1 If Tablo(i, 1) = Nb Then 'Préparation filtre Facture Criteres(k) = Tablo(i, 8) & "": k = k + 1 Exit For End If Next J End If Next i 'Filtre Facture [Donnees].ListObject.Range.AutoFilter Field:=8, Criteria1:=Criteres, Operator:=xlFilterValues 'Filtre Article ReDim Criteres(1 To Nb) For i = 1 To Nb Criteres(i) = LChoix(i, 1) & "" Next i [Donnees].ListObject.Range.AutoFilter Field:=3, Criteria1:=Criteres, Operator:=xlFilterValues End Sub
Une explication agréable et claire, merci pour vos efforts et votre temps avec moi

1 pièce(s) jointe(s)

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
Sub Filtrer()
Dim Tablo()
Dim LChoix()
Dim Criteres()
Dim Nb As Integer, i As Long, J As Long, k As Long
'Nombre de Numéro d'article choisis
Nb = WorksheetFunction.CountA(Range("Choix").ListObject.ListColumns(1).DataBodyRange)
'Remplissage de l'array LChoix depuis la partie remplie du tableau Choix
LChoix = Range("Choix").ListObject.ListColumns(1).DataBodyRange.Resize(Nb, 1)
'Remplissage de l'array Tablo depuis le tableau Donnees
Tablo = Range("Donnees").ListObject.DataBodyRange
'Repérage des lignes ayant un des Numéro d'article choisis
For i = 1 To UBound(Tablo)
    For J = 1 To Nb
        If Tablo(i, 8) = LChoix(J, 1) Then Tablo(i, 1) = 1: Exit For Else Tablo(i, 1) = 0
    Next J
Next i
'Repérage des lignes déjà repérées partageant une même Facture + Préparation filtre Facture
ReDim Criteres(1 To UBound(Tablo))
k = 1
For i = 1 To UBound(Tablo)
    If Tablo(i, 1) = 1 Then
        For J = 1 To UBound(Tablo)
            If Tablo(i, 13) = Tablo(J, 13) And J <> i And Tablo(J, 1) >= 1 Then Tablo(i, 1) = Tablo(i, 1) + 1
            If Tablo(i, 1) = Nb Then
                'Préparation filtre Facture
                Criteres(k) = Tablo(i, 13) & "": k = k + 1
                Exit For
            End If
        Next J
    End If
Next i
'Filtre Facture
[Donnees].ListObject.Range.AutoFilter Field:=13, Criteria1:=Ar_Re(Criteres), Operator:=xlFilterValues
'Filtre Article
ReDim Criteres(1 To Nb)
For i = 1 To Nb
    Criteres(i) = LChoix(i, 1) & ""
Next i
[Donnees].ListObject.Range.AutoFilter Field:=8, Criteria1:=Criteres, Operator:=xlFilterValues
End Sub
Function Ar_Re(Ar)
Dim i, r
With CreateObject("scripting.dictionary")
For r = LBound(Ar) To UBound(Ar)
    If Ar(r) > "" Then
        If Not .Exists(Ar(r)) Then .Add Ar(r), Nothing
    End If
Next r
If .Count > 0 Then Ar_Re = .Keys
End With
End Function

J'ai essayé ce mod mais il montre les factures qui correspondent à l'article pas tout le monde

08/06/2020, 09h37
78chris
RE

Une ligne a sauté dans le code que j'ai posté (en effaçant un commentaire j'ai du l'effacer par inadvertance)
je te mets les 2 lignes qui suivent pour que tu repères
Code:

1 2 3 ReDim Preserve Criteres(k - 1) 'Filtre Facture [Donnees].ListObject.Range.AutoFilter Field:=8, Criteria1:=Criteres, Operator:=xlFilterValues
09/06/2020, 00h49
alidroos

Un message d'erreur apparaît

Code:

On error resume next

Cela fonctionne efficacement

:king: 78chris
09/06/2020, 09h33
78chris

Bonjour

Je n'ai pas mis de

Code:

On error resume next

que j'évite au maximum

Un erreur s'analyse et se corrige

Voir 40 message(s) de cette discussion en une page