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
| Option Compare Database
Option Explicit
Public Function zonesEligibles(pClient As String) As Variant
' Ceci est la fonction qui renvoit la liste des zones éligibles pour un client
' La valeur retournée est de cette forme : "SUD:01;NORD:03"
Dim strSQL As String, strZone As String
Dim rstZonesProbables As DAO.Recordset
' On récupère les zones susceptibles d'être éligibles
strSQL = "SELECT DISTINCT Secteur, Eligibilité " & _
"FROM Clients INNER JOIN Eligibilité " & _
"ON (Clients.Condition3 = Eligibilité.Condition3) " & _
"AND (Clients.Condition2 = Eligibilité.Condition2) " & _
"AND (Clients.Condition1 = Eligibilité.Condition1) " & _
"WHERE Client='" & pClient & "';"
Set rstZonesProbables = CurrentDb.OpenRecordset(strSQL)
' Pour chacune de ces zones,
While Not rstZonesProbables.EOF
' On réunit les champs Secteur et éligibilité séparés par ":"
strZone = rstZonesProbables(0) & ":" & rstZonesProbables(1)
' On vérifie si le client est éligible. Si c'est le cas, on concatène les zones séparées par des point-virgules
If eligibiliteZone(pClient, strZone) Then
zonesEligibles = zonesEligibles & ";" & strZone
End If
rstZonesProbables.MoveNext
Wend
' On retire le premier point-virgule
If Len(zonesEligibles) <> 0 Then zonesEligibles = Right(zonesEligibles, Len(zonesEligibles) - 1)
End Function
Private Function eligibiliteZone(pClient As String, pZone As String) As Boolean
Dim strSQL As String, strSecteur As String, strEligibilite As String
Dim rstConditionsClient As DAO.Recordset, rstRegroupementConditions As DAO.Recordset
Dim verif As Boolean
' Initialisation
verif = False
' On sépare les champs "Secteur" et "éligibilité"
strSecteur = Left(pZone, InStr(pZone, ":") - 1)
strEligibilite = Right(pZone, Len(pZone) - InStr(pZone, ":"))
' On récupère les conditions du client
strSQL = "SELECT Condition1, Condition2, Condition3, Client FROM Clients WHERE Client = '" & pClient & "';"
Set rstConditionsClient = CurrentDb.OpenRecordset(strSQL)
' On récupère les conditions de la zone regroupées sur les 2 premières conditions(les "ET" d'abord, les "OU" à la fin)
strSQL = "SELECT DISTINCT Secteur, Eligibilité, Condition1, Condition2, Relation " & _
"FROM Eligibilité " & _
"WHERE Secteur='" & strSecteur & "' AND Eligibilité='" & strEligibilite & "' " & _
"ORDER BY Relation, Condition1, Condition2;"
Set rstRegroupementConditions = CurrentDb.OpenRecordset(strSQL)
Do Until rstRegroupementConditions.EOF
verif = correspondCondition(rstConditionsClient, rstRegroupementConditions.Fields)
If Not verif Then Exit Do
rstRegroupementConditions.MoveNext
Loop
eligibiliteZone = verif
End Function
Private Function correspondCondition(rstClient As DAO.Recordset, fldsConditions As DAO.Fields) As Boolean
Dim fld As DAO.Field
Dim strSQL As String
Dim rstConditionsCompletes As DAO.Recordset
Dim test As Boolean
strSQL = "SELECT DISTINCT Condition1, Condition2, Condition3, Relation " & _
"FROM Eligibilité " & _
"WHERE Secteur='" & fldsConditions(0).Value & "' " & _
"AND Eligibilité='" & fldsConditions(1).Value & "' " & _
"AND Condition1='" & fldsConditions(2).Value & "' " & _
"AND Condition2='" & fldsConditions(3).Value & "' " & _
"AND Relation='" & fldsConditions(4).Value & "' " & _
"ORDER BY Relation, Condition1, Condition2,Condition3;"
Set rstConditionsCompletes = CurrentDb.OpenRecordset(strSQL)
Do Until rstConditionsCompletes.EOF
test = False
rstClient.MoveFirst
Do Until rstClient.EOF
If rstClient(0) = rstConditionsCompletes(0) And rstClient(1) = rstConditionsCompletes(1) And rstClient(2) = rstConditionsCompletes(2) Then
test = True
Exit Do
End If
rstClient.MoveNext
Loop
If (test And rstConditionsCompletes(3) = "OU") Or (Not test And rstConditionsCompletes(3) = "ET") Then Exit Do
rstConditionsCompletes.MoveNext
Loop
rstClient.MoveFirst
If rstClient(3) = "C3" And fldsConditions(0).Value = "SUD" And fldsConditions(1).Value = "02" Then Debug.Print test
correspondCondition = test
End Function |
Programme VBA trouvant une valeur répondant à plusieurs conditions ET/OU (non résolu par requête SQL)
Répondre avec citation
Envoyé par Simplifi
Mille mercis.
j'ai compris comment activer les fonctions à travers ton exemple 
Partager