Code de recherche avec plusieurs conditions

Version imprimable

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

01/06/2020, 19h54
alidroos

1 pièce(s) jointe(s)

Code de recherche avec plusieurs conditions

Bonjour à tous

Je veux qu'un code recherche une valeur Exemple:

Pièce jointe 569388

Lors de la recherche de numéros spécifiques
Les résultats de recherche montrent qu'un seul numéro de facture
01/06/2020, 22h18
alidroos

1 pièce(s) jointe(s)

Une photo pour expliquer la demande
03/06/2020, 00h49
alidroos

Tout d'abord les classes pour chaque classe dans une matrice distincte
Deuxièmement les numéros de facturation dans chaque matrice

Malheureusement j'ai essayé de créer un code que je n'ai pas pu compléter

1 pièce(s) jointe(s)

Bonjour sidiAli
je sais pas si j'ai bien compris la demande : recherche une liste de 3 articles entre deux date pour alimenter un listbox
si c'est ça voila ce que je propose :

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
Private Sub CommandButton1_Click()
ListBox1.Clear
Dim O As Worksheet
Set O = Sheets("Feuil1")
Dim Derlig As Long
Dim Lista As Variant
Application.ScreenUpdating = False
Derlig = O.Cells(Rows.Count, 1).End(xlUp).Row
CR1 = ComboBox1.Value
CR2 = ComboBox2.Value
CR3 = ComboBox3.Value
CR4 = CDate(TextBox1.Value)
CR5 = CDate(TextBox2.Value)
 If O.AutoFilterMode = True Then
  O.AutoFilterMode = False
 End If
  O.Range("B1").AutoFilter Field:=2, Criteria1:=">=" & CLng(CR4), Operator:=xlAnd, Criteria2:="<=" & CLng(CR5)
 O.Range("F1").AutoFilter Field:=6, Criteria1:=Array(CR1, CR2, CR3), Operator:=xlFilterValues
 With ListBox1
    .ColumnCount = 6
    .List = Range("A2:F" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value
End With
 O.ShowAllData
Application.ScreenUpdating = True
End Sub
 
 
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 2 To Sheets("feuil1").Range("A65536").End(xlUp).Row
  ComboBox1 = Sheets("feuil1").Range("F" & i)
  ComboBox2 = Sheets("feuil1").Range("F" & i)
  ComboBox3 = Sheets("feuil1").Range("F" & i)
  If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Sheets("feuil1").Range("F" & i)
  If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem Sheets("feuil1").Range("F" & i)
  If ComboBox3.ListIndex = -1 Then ComboBox3.AddItem Sheets("feuil1").Range("F" & i)
Next i
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
 
End Sub

à tester et revenir avec plus de précision si c'est pas ce que tu cherches

1 pièce(s) jointe(s)

Merci pour votre interaction monsieur BENNASR

Je souhaite rechercher des articles dans divers états de facturation afin que les résultats ne figurent que dans une facture

Exemple de recherche d'articles

1- 152322
2- 152324
3- 152326

Dans les données

Facture Date La façon Numéro Client Nom du compte N° Article

1 15/01/2020 A 1122 VENTE 152322

2 16/01/2020 A 1122 VENTE 150000

3 17/01/2020 A 1122 VENTE 152322

4 18/01/2020 A 1122 VENTE 150000

1 19/01/2020 A 1122 VENTE 152324

5 20/01/2020 A 1122 VENTE 150000

1 21/01/2020 A 1122 VENTE 152326

52 22/01/2020 A 1122 VENTE 150000

95 23/01/2020 A 1122 VENTE 152326

2 16/01/2020 A 1122 VENTE 150000

3 17/01/2020 A 1122 VENTE 152322

3 19/01/2020 A 1122 VENTE 152324

Les résultats apparaissent en rouge uniquement de sorte que la recherche prédit les factures des articles si les articles spécifiés sont présents dans une facture spécifique

03/06/2020, 13h39
BENNASR

joindre un fichier test sans données confidentielles et expliquer avec un exemple concret
je réponds demain car je quitte mon bolo ds 10 minutes
03/06/2020, 17h49
alidroos

1 pièce(s) jointe(s)

Cette pièce jointe contient des données complètes
03/06/2020, 17h51
alidroos

Désolé je n'ai pas pu télécharger le fichier dans sa grande taille. Les données d'origine sont estimées à 120 000 rows
03/06/2020, 17h58
alidroos

1 pièce(s) jointe(s)

Les résultats sont des factures qui contiennent uniquement les clauses de condition

Je suis montré sur les lignes en couleur rouge

Facture	Date	La façon	Numéro Client	Nom du compte	N° Article
1	15/01/2020	A	1122	VENTE	152322
2	16/01/2020	A	1122	VENTE	150000
3	17/01/2020	A	1122	VENTE	152322
4	18/01/2020	A	1122	VENTE	150000
1	19/01/2020	A	1122	VENTE	152324
5	20/01/2020	A	1122	VENTE	150000
1	21/01/2020	A	1122	VENTE	152326
52	22/01/2020	A	1122	VENTE	150000
95	23/01/2020	A	1122	VENTE	152326
2	16/01/2020	A	1122	VENTE	150000
3	17/01/2020	A	1122	VENTE	152322
3	19/01/2020	A	1122	VENTE	152324

Trouver la facture des articles

Numéro d'article
1463527
1517029
1520739

Le résultat

prix Quantité Numéro d'article nom du compte Numéro de client la façon de payer Date Facture

57 1 1463527 slae ins 2120018 Ventes à terme 05/10/2020 210294

10 7 1517029 slae ins 2120018 Ventes à terme 05/10/2020 210294

11 2 1520739 slae ins 2120018 Ventes à terme 05/10/2020 210294

La facture allez : 210294

prix	Quantité	Numéro d'article	nom du compte	Numéro de client	la façon de payer	Date	Facture
57	1	1463527	slae ins	2120018	Ventes à terme	05/10/2020	210294
10	7	1517029	slae ins	2120018	Ventes à terme	05/10/2020	210294
11	2	1520739	slae ins	2120018	Ventes à terme	05/10/2020	210294

Bonjour,

Citation:

Envoyé par alidroos

Trouver la facture des articles

Si j'ai compris ce que tu veux faire, voici un code qui devrait te donner ton résultat :

Code:

1
2
3
4
5
6
7
8
Dim no_article As String, ldf As Range
    no_article = "ton numéro d'article à chercher"
    Set ldf = Sheets("Factures").Columns("C").Find(no_article, [C1], xlValues, xlWhole)
    If ldf Is Nothing Then
        MsgBox "Article non trouvé"
    Else
        MsgBox "Facture N° : " & ldf.Offset(0, 5).Value
    End If

03/06/2020, 23h46
alidroos

Bonjour anasecu

Ce n'est pas ce que je veux

les conditions 3
Le résultat est uniquement sur une facture

Exemple de recherche pour

Numéro d'article
1076164
1076166

Le résultat

Facture
210573
210573

Parce que la réponse aux conditions se trouve dans la même facture

Voir le dossier avec un post #7

1 pièce(s) jointe(s)

bonjour DALI
j'ai testé sur un fichier et j'ai pris que qq lignes de données (donc fichier non conformes à la tienne)
à tester avec prudence je n'ai qu'un autodidacte VBA

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
Private Sub CommandButton1_Click()
ListBox1.Clear
Dim O As Worksheet
Set O = Sheets("Feuil1")
Dim Derlig As Long
Dim Lista As Variant
Application.ScreenUpdating = False
Derlig = O.Cells(Rows.Count, 1).End(xlUp).Row
CR1 = ComboBox1.Value
CR2 = ComboBox2.Value
CR3 = ComboBox3.Value
CR4 = CDate(TextBox1.Value)
CR5 = CDate(TextBox2.Value)
 
 If O.AutoFilterMode = True Then
 O.AutoFilterMode = False
 End If
 O.Range("G9").AutoFilter Field:=7, Criteria1:=">=" & CLng(CR4), Operator:=xlAnd, Criteria2:="<=" & CLng(CR5)
 O.Range("C9").AutoFilter Field:=3, Criteria1:=Array(CR1, CR2, CR3), Operator:=xlFilterValues
 Dim C As Range
 With ListBox1
    .ColumnCount = 6
    .ColumnWidths = "100;80;100;0;100;60"
End With
 
LastLig = O.Cells(O.Rows.Count, 3).End(xlUp).Row
 
    If O.Range("C10:C" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
    For Each C In O.Range("C10:C" & LastLig).SpecialCells(xlCellTypeVisible)
        ListBox1.AddItem C.Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 1) = C.Offset(0, 1).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 2) = C.Offset(0, 2).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 3) = C.Offset(0, 3).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 4) = C.Offset(0, 4).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 5) = C.Offset(0, 5).Value
        Me.ListBox1.List(ListBox1.ListCount - 1, 6) = C.Offset(0, 6).Value
 
    Next C
    End If
 O.ShowAllData
Application.ScreenUpdating = True
End Sub
 
 
Private Sub UserForm_Initialize()
Dim i As Integer
For i = 10 To Sheets("feuil1").Range("A65536").End(xlUp).Row
  ComboBox1 = Sheets("feuil1").Range("C" & i)
  ComboBox2 = Sheets("feuil1").Range("C" & i)
  ComboBox3 = Sheets("feuil1").Range("C" & i)
  If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem Sheets("feuil1").Range("C" & i)
  If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem Sheets("feuil1").Range("C" & i)
  If ComboBox3.ListIndex = -1 Then ComboBox3.AddItem Sheets("feuil1").Range("C" & i)
Next i
ComboBox1.Value = ""
ComboBox2.Value = ""
ComboBox3.Value = ""
 
End Sub

04/06/2020, 19h27
alidroos

Merci d'avoir interagi avec moi BENNASR

Le dernier fichier a approché la solution

Exemple de groupe de facturation

1- Facture1

1463527 slae ins 2120018 Ventes à terme 05/10/2020
1468910 slae ins 2120018 Ventes à terme 05/10/2020
1476802 slae ins 2120018 Ventes à terme 05/10/2020
1479689 slae ins 2120018 Ventes à terme 05/10/2020
1490516 slae ins 2120018 Ventes à terme 05/10/2020
1515685 slae ins 2120018 Ventes à terme 05/10/2020
1515797 slae ins 2120018 Ventes à terme 05/10/2020

2- Facture2

1076164 slae ins 2120018 Ventes à terme 16/05/2020
1076166 slae ins 2120018 Ventes à terme 16/05/2020
1476802 slae ins 2120018 Ventes à terme 16/05/2020
1403990 slae ins 2120018 Ventes à terme 16/05/2020
1519982 slae ins 2120018 Ventes à terme 16/05/2020

3-Facture3

1076165 slae ins 2120018 Ventes à terme 16/05/2020
1101933 slae ins 2120018 Ventes à terme 16/05/2020
1239083 slae ins 2120018 Ventes à terme 16/05/2020
1265205 slae ins 2120018 Ventes à terme 16/05/2020
1399979 slae ins 2120018 Ventes à terme 16/05/2020
1476802 slae ins 2120018 Ventes à terme 16/05/2020
1493491 slae ins 2120018 Ventes à terme 16/05/2020
1514005 slae ins 2120018 Ventes à terme 16/05/2020
1514008 slae ins 2120018 Ventes à terme 16/05/2020
1514009 slae ins 2120018 Ventes à terme 16/05/2020
1514014 slae ins 2120018 Ventes à terme 16/05/2020
1514783 slae ins 2120018 Ventes à terme 16/05/2020

Je veux trouver les éléments suivants, ils apparaîtront dans trois factures:
1463527
1476802

Le résultat correct est la facture1
Parce qu'il contenait les deux conditions
04/06/2020, 19h32
alidroos

Comment les lignes peuvent-elles être exprimées en groupes? Chaque groupe signifie une facture spécifique
04/06/2020, 22h02
BENNASR

Donc tu cherches la facture qui contient les trois code et non pas au moins l'une des articles c'est ça _?
As tu pensé à faire ca avec TCD ?

Oui c'est ce que je recherche monsieur BENNASR

Citation:

Donc tu cherches la facture qui contient les trois code et non pas au moins l'une des articles c'est ça _?

Notez ce code. Je ne travaille pas avec des matrices, je pense qu'il a besoin d'une légère modification pour fonctionner dans tous les cas

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
Sub tst()
Dim Ar, Arr, AA, BB, CC
Dim A, B, C, D
Dim r, Inx, i, ii, iii, iiii, x, Mx, M, rr, V, N
Dim Mrx(), Mtrx1(), Mtrx2(), Mtrx3(), Totl(), Tol(), Z()
'====================================
Ar = Array(1463527, 1517029, 1520739)
'====================================
Arr = Range("F").Value
'====================================
For r = LBound(Arr, 1) To UBound(Arr, 1)
A = Arr(r, 3)
B = Arr(r, 8)
    If A Like Int(Ar(0)) Or A Like Int(Ar(1)) Or A Like Int(Ar(2)) Then
        Inx = Inx + 1
        ReDim Preserve Mrx(1 To 2, 1 To Inx)
        Mrx(1, Inx) = A
        Mrx(2, Inx) = B
    End If
Next r
If Inx > 0 Then
AA = Application.Transpose(Mrx)
For i = LBound(AA, 1) To UBound(AA, 1)
    If AA(i, 1) = Ar(0) Then
       ii = ii + 1
       ReDim Preserve Mtrx1(1 To 2, 1 To ii)
       Mtrx1(1, ii) = AA(i, 1)
       Mtrx1(2, ii) = AA(i, 2)
    End If
    If AA(i, 1) = Ar(1) Then
       iii = iii + 1
       ReDim Preserve Mtrx2(1 To 2, 1 To iii)
       Mtrx2(1, iii) = AA(i, 1)
       Mtrx2(2, iii) = AA(i, 2)
    End If
    If AA(i, 1) = Ar(2) Then
       iiii = iiii + 1
       ReDim Preserve Mtrx3(1 To 2, 1 To iiii)
       Mtrx3(1, iiii) = AA(i, 1)
       Mtrx3(2, iiii) = AA(i, 2)
    End If
Next i
End If
Erase AA
AA = Application.Transpose(Mtrx1)
BB = Application.Transpose(Mtrx2)
CC = Application.Transpose(Mtrx3)
For r = LBound(AA, 1) To UBound(AA, 1)
    For rr = LBound(BB, 1) To UBound(BB, 1)
        If AA(r, 2) = BB(rr, 2) Then
           x = x + 1
           ReDim Preserve Totl(1 To 2, 1 To x)
           Totl(1, x) = BB(rr, 1)
           Totl(2, x) = BB(rr, 2)
        End If
    Next rr
Next r
If x > 0 Then
x = 0
For Mx = LBound(AA, 1) To UBound(AA, 1)
    For M = LBound(CC, 1) To UBound(CC, 1)
        If AA(Mx, 2) = CC(M, 2) Then
           x = x + 1
           ReDim Preserve Tol(1 To 2, 1 To x)
           Tol(1, x) = CC(M, 1)
           Tol(2, x) = CC(M, 2)
        End If
    Next M
Next Mx
End If
If x > 0 Then
C = Application.Transpose(Totl)
D = Application.Transpose(Tol)
For rr = LBound(C, 1) To UBound(C, 1)
    For V = LBound(D, 1) To UBound(D, 1)
        If C(rr, 2) = D(V, 2) Then
            N = N + 1
            ReDim Preserve Z(1 To N)
            Z(N) = C(rr, 2)
        End If
    Next V
Next rr
If N > 0 Then
    Range("L9").Resize(UBound(Z, 1), 1) = Z
End If
Erase Mrx(): Erase AA: Erase BB: Erase CC: Erase C: Erase D
Erase Mtrx1(): Erase Mtrx2(): Erase Mtrx3(): Erase Totl(): Erase Tol()
End If
End Sub

05/06/2020, 01h49
alidroos

Citation:

As tu pensé à faire ca avec TCD ?

Malheureusement nous n'avons aucune expérience
Veuillez essayer à travers vous
05/06/2020, 19h12
alidroos

:arf:
05/06/2020, 20h38
alidroos

Qui a l'expérience TCD ?
J'espère qu'il participera à la résolution du problème. Je n'ai pas trouvé de solution pour me désespérer

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