Recherches cumulatives ou exclusives multicritères in sql database

Commenter

Contenu du snippet

C'est une recherche dans une base de films : les films peuvent être sous différents supports (de zéro à l'infini). De plus, on peut choisir un nombre illimité de critères de recherche (y compris zéro). Le support comme les critères peuvent entrer dans la recherche dans le cadre d'une recherche exclusive comme inclusive, indépendamment les uns des autres.

Quatre types de recherches seront possibles. En guise d'exemple, je vais donner l'enjeu de chacune des situations en français, puis le traduire en SQL.

RECHERCHE EXCLUSIVE
Je cherche un film qui soit sur DVD et sur VHS et qui comporte "Jean" tant dans le nom du réalisateur que dans le nom d'un acteur.
SQL très simplifié ==> "dvd" AND "vhs" AND "réalisateur" AND "acteur"

RECHERCHE A SUPPORT EXCLUSIF
Je cherche un film qui soit sur DVD et sur VHS et qui ait au moins un "Jean" dans le nom du réalisateur ou d'un acteur.
SQL très simplifié ==> "dvd" AND "vhs" AND "réalisateur" OR "dvd" AND "vhs" AND "acteur"

RECHERCHE A SUPPORTS CUMULES
Je cherche un film qui soit sur DVD ou sur VHS et qui comporte "Jean" tant dans le nom du réalisateur que dans le nom d'un acteur.
SQL très simplifié ==> "dvd" AND "réalisateur" AND "acteur" OR "vhs" AND "réalisateur" AND "acteur"

RECHERCHE CUMULATIVE
Je cherche un film qui soit sur DVD ou sur VHS et qui ait au moins un "Jean" dans le nom du réalisateur ou d'un acteur.
SQL très simplifié ==> "dvd" AND "réalisateur" OR "vhs" AND "réalisateur" OR "dvd" AND "acteur" OR "vhs" AND "acteur"

Source / Exemple : 


Public Function Recherche(SuppFind As Boolean, CritFind As Boolean)
Dim Criteres As String, Support As String, CritRech As String
Dim FirstCritSupp As Boolean, SecondCritSupp As Boolean

FrmIndex.GridList.Rows = 2
FrmIndex.GridList.Clear
FrmIndex.GridList.Visible = False
DoEvents
FirstCritSupp = False
SecondCritSupp = False
Support = ""
CritRech = ""

'Si la recherche est exclusive pour les supports
If SuppFind = True Then
    'Si la recherche est exclusive pour les critères
    If CritFind = True Then
        'Pour chaque support on le rajoute dans la liste des supports
        For indexCmbFindSup = 1 To FrmIndex.ChkFindSup.Count - 1
            If FrmIndex.ChkFindSup(indexCmbFindSup).Value = 1 Then
                If FirstCritSupp = False Then
                    Support = LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                    FirstCritSupp = True
                Else
                    Support = Support & " AND " & LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                End If
            End If
        Next
        'Pour chaque critère on le rajoute dans la liste des critères
        For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
            If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                If FirstCritSupp = False Then
                    CritRech = FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                    FirstCritSupp = True
                Else
                    CritRech = CritRech & " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                End If
            End If
        Next
        'Messages d'erreur et sinon on rassemble les supports et les critères
        If Support = "" Then
            MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title
            Exit Function
        Else
            If CritRech = "" Then
                MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title
                Exit Function
            Else
                Criteres = Support & CritRech
            End If
        End If
    'Si la recherche est cumulative pour les critères
    Else
        'Pour chaque critère on cherche les supports
        For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
            If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                CritRech = " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                If SecondCritSupp = False Then
                    SecondCritSupp = True
                    'On créé la liste des supports
                    For indexCmbFindSup = 1 To FrmIndex.ChkFindSup.Count - 1
                        If FrmIndex.ChkFindSup(indexCmbFindSup).Value = 1 Then
                            If FirstCritSupp = False Then
                                Support = LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                                FirstCritSupp = True
                            Else
                                Support = Support & " AND " & LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                            End If
                            Criteres = "(" & Support & CritRech & ")"
                        End If
                    Next
                Else
                    'Pour chaque support on le rajoute à la liste des supports
                    For indexCmbFindSup = 1 To FrmIndex.ChkFindSup.Count - 1
                        If FrmIndex.ChkFindSup(indexCmbFindSup).Value = 1 Then
                            If FirstCritSupp = False Then
                                Support = LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                                FirstCritSupp = True
                            Else
                                Support = Support & " AND " & LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                            End If
                            Criteres = Criteres & " OR (" & Support & CritRech & ")"
                        End If
                    Next
                End If
            End If
        Next
        If Support = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
        If CritRech = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
        
    End If
'Si la recherche est cumulative pour les supports
Else
    'Si la recherche est exclusive pour les critères
    If CritFind = True Then
        'Pour chaque support on cherche les critères
        For indexCmbFindSup = 1 To FrmIndex.ChkFind.Count - 1
            If FrmIndex.ChkFindSup(indexCmbFindSup).Value = 1 Then
                Support = LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                If SecondCritSupp = False Then
                    SecondCritSupp = True
                    'On créé la liste des critères
                    For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
                        If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                            CritRech = CritRech & " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                            Criteres = "(" & Support & CritRech & ")"
                        End If
                    Next
                    If CritRech = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
                Else
                    'Pour chaque critère on le rajoute à la liste des critères
                    For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
                        If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                            CritRech = CritRech & " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                            Criteres = Criteres & " OR (" & Support & CritRech & ")"
                        End If
                    Next
                    If CritRech = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
                End If
            End If
            If Support = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
        Next
    'Si la recherche est cumulative pour les critères
    Else
        'Pour chaque support on cherche les critères
        For indexCmbFindSup = 1 To FrmIndex.ChkFind.Count - 1
            If FrmIndex.ChkFindSup(indexCmbFindSup).Value = 1 Then
                Support = LireINI("InterfaceLoad", "CmbFindSup" & indexCmbFindSup & "Title") & "='1'"
                If SecondCritSupp = False Then
                    'Pour chaque critère on le rajoute à la liste de critères
                    For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
                        If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                            CritRech = " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                            If FirstCritSupp = False Then
                                Criteres = "(" & Support & CritRech & ")"
                                FirstCritSupp = True
                            Else
                                Criteres = Criteres & " OR (" & Support & CritRech & ")"
                            End If
                        End If
                    Next
                    If CritRech = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
                    SecondCritSupp = True
                Else
                    'Pour chaque critère on le rajoute à la liste de critères
                    For indexCmbFind = 1 To FrmIndex.ChkFind.Count - 1
                        If FrmIndex.ChkFind(indexCmbFind).Value = 1 Then
                            CritRech = " AND " & FrmIndex.CmbFind(indexCmbFind).Tag & " LIKE '%" & FrmIndex.CmbFind(indexCmbFind).Text & "%'"
                            Criteres = Criteres & " OR (" & Support & CritRech & ")"
                        End If
                    Next
                    If CritRech = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
                End If
            End If
        Next
        If Support = "" Then MsgBox "Veuillez sélectionner un ou plusieurs critères de recherche. ", vbCritical, "Erreur dans " & App.Title: Exit Function
        
    End If
    
End If

ConnectionBase
Set enreg = New Recordset
    L = 1
    enreg.Open "SELECT FILMno,FILMreal,FILMtito,FILMtitf,FILMpays,FILMdate,FILMlang,FILMcoul,FILMacte,FILMscen,FILMimag,FILMmont,FILMmusi," & _
"DVD,DVDajou,DVDform,DVDcoul,DVDlang,DVDsstt,DVDchai,DVDdate,DVDdure,DVDautr,DVDqual,DVDep,DVDlp,VHS,VHSajou,VHSform," & _
"VHScoul,VHSlang,VHSsstt,VHSchai,VHSdate,VHSdure,VHSautr,VHSqual,VHSrest,VHSchro " & _
               "FROM [Films] " & _
               "WHERE " & Criteres & " ORDER BY FILMtito", _
              conne, adOpenStatic, adLockReadOnly
    enreg.MoveFirst
    Do Until enreg.EOF
        contenu = enreg!FILMno & Chr(9) & enreg!FILMreal & Chr(9) & enreg!FILMtito & Chr(9) & enreg!FILMtitf & _
Chr(9) & enreg!FILMpays & Chr(9) & enreg!FILMdate & Chr(9) & enreg!FILMlang & Chr(9) & enreg!FILMcoul & _
Chr(9) & enreg!FILMacte & Chr(9) & enreg!FILMscen & Chr(9) & enreg!FILMimag & Chr(9) & enreg!FILMmont & _
Chr(9) & enreg!FILMmusi & Chr(9) & enreg!DVD & Chr(9) & enreg!DVDajou & Chr(9) & enreg!DVDform & _
Chr(9) & enreg!DVDcoul & Chr(9) & enreg!DVDlang & Chr(9) & enreg!DVDsstt & Chr(9) & enreg!DVDchai & _
Chr(9) & enreg!DVDdate & Chr(9) & enreg!DVDdure & Chr(9) & enreg!DVDautr & Chr(9) & enreg!DVDqual & _
Chr(9) & enreg!DVDep & Chr(9) & enreg!DVDlp & Chr(9) & enreg!VHS & Chr(9) & enreg!VHSajou & _
Chr(9) & enreg!VHSform & Chr(9) & enreg!VHScoul & Chr(9) & enreg!VHSlang & Chr(9) & enreg!VHSsstt & _
Chr(9) & enreg!VHSchai & Chr(9) & enreg!VHSdate & Chr(9) & enreg!VHSdure & Chr(9) & enreg!VHSautr & _
Chr(9) & enreg!VHSqual & Chr(9) & enreg!VHSrest & Chr(9) & enreg!VHSchro
        
        FrmIndex.GridList.AddItem contenu
        FrmFlash.ProgFlash.Value = L / nb_film * 100
        enreg.MoveNext
        L = L + 1
    Loop
    FrmIndex.GridList.Visible = True
    Call Progression(False)
    enreg.Close
Set enreg = Nothing
DeConnectionBase (True)
End Function

Conclusion :


Comme vous aurez pu le constater il n'y a qu'un quart du code, et c'est comme par hasard le quart le plus simple à programmer. Je poste ici parce que ce sujet en intéressera sûrement plus d'un ; si par la même occasion les intéressés pouvaient publier dans les commentaires une solution à ce problème de recherche, ce serait bienvenu.

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (vbromanoff)