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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
| Sub GO_Find_Multi_Criteres()
Dim r As Range 'Le champ de recherche
Dim vLookIn As Long
vLookIn = xlValues 'xlValues 'xlFormulas
Set f1 = ThisWorkbook.Worksheets("Feuil1")
If vLookIn = xlValues Then
f1.Columns.AutoFit
f1.Cells.ShrinkToFit = True
End If
'les criteres se trouvent en $A2:$D2, le total a rechercher en $E2
Ligne = 2
OffSet_Total = 4
TotalRechercher = f1.Cells(Ligne, 1).Offset(0, OffSet_Total).Value
ReDim crit(4)
For i = 1 To 4
If vLookIn = xlValues Then
crit(i) = f1.Cells(Ligne, i).Text
Else
crit(i) = f1.Cells(Ligne, i).Value
End If
Next
Dim w2 As Workbook
Set w2 = ThisWorkbook 'Le classeur où effectuer la recherche
Set f2 = w2.Worksheets("Retrouver_un_montant")
Set r = f2.Cells 'La recherche s'effectue sur toute la feuille
Set r = f2.Columns("A:O") 'ou définir un champ restreint
Set Result = DataFind(r, TotalRechercher, OffSet_Total, crit, vLookIn)
If Result Is Nothing Then
MsgBox "Aucun resultat", , TotalRechercher
Else
For Each c In Result.Areas
Debug.Print c.Address
Next
MsgBox Result.Address, , TotalRechercher
End If
If vLookIn = xlValues Then
f1.Cells.ShrinkToFit = False
End If
End Sub
Function CheckCriteres(c, crit, WhereLookIn)
Set CheckCriteres = c
ok = False
For i = 2 To 4
If WhereLookIn = xlFormulas Then
TheData = c.Offset(0, i - 1).Value
Else
TheData = c.Offset(0, i - 1).Text
End If
If TheData <> crit(i) Then
Set CheckCriteres = Nothing
Exit Function
End If
Next
End Function
Private Function DataFind(r, TotalRechercher, OffSet_Total, crit, WhereLookIn)
Dim ResultCrit As Range
Set ResultCrit = Nothing
If WhereLookIn = xlValues Then
r.Columns.AutoFit
r.ShrinkToFit = True
End If
v = crit(1)
Set DataFind = Nothing
Set ResultCrit = Nothing
Set rg = r.Find(v, LookAt:=xlWhole, LookIn:=WhereLookIn, After:=r.Cells(r.Cells.Rows.Count, r.Cells.Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If rg Is Nothing Then
Set DataFind = Nothing
Else
Set ResultCrit = CheckCriteres(rg, crit, WhereLookIn)
FirstAddress = rg.Address
Do
Set rg = r.FindNext(rg)
If ResultCrit Is Nothing Then
Set checkcrit = CheckCriteres(rg, crit, WhereLookIn)
If Not checkcrit Is Nothing Then
Set ResultCrit = checkcrit
End If
Else
Set checkcrit = CheckCriteres(rg, crit, WhereLookIn)
If Not checkcrit Is Nothing Then
Set ResultCrit = Application.Union(ResultCrit, checkcrit)
End If
End If
Loop While Not rg Is Nothing And rg.Address <> FirstAddress
End If
If Not ResultCrit Is Nothing Then
For i = 1 To ResultCrit.Areas.Count
Total = 0
For Each c In ResultCrit.Areas(i)
Total = Total + c.Offset(0, OffSet_Total).Value
Next
If Total = TotalRechercher Then
If DataFind Is Nothing Then
Set DataFind = ResultCrit.Areas(i)
Else
Set DataFind = Application.Union(DataFind, ResultCrit.Areas(i))
End If
'ResultCrit.Areas(i).Select
Else
End If
Next i
End If
If WhereLookIn = xlValues Then
r.ShrinkToFit = False
End If
End Function |
faire un programme qui permet de retrouver un montant
Répondre avec citation
, la difficulté va dépendre du nombre d'éléments de la liste sur lesquels il faut porter la recherche. S'il n'y a que 4 éléments qui ont la référence 2012.12 P_VISEE3 E_BEEFRA I_S-P, il suffit de trouver ces 4 éléments sans se préoccuper de l'opération. Par contre, si la recherche doit porter sur une liste de 50 éléments ayant la référence 2012.12 P_VISEE3 E_BEEFRA I_S-P, il faut examiner les combinaisons de 4 nombres parmi 100 nombres (50 positifs et 50 négatifs), soit 3921225 combinaisons afin de trouver celles qui satisfont au résultat.
Partager