Petite base de donnees et recherche

Private Sub Workbook_Open() 'à l'ouverture du classeur
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dico As Object 'déclare la variable dico (DICtiOnnaire)
Dim cel As Range 'déclare la variable cel (CELLule)
Dim temp As Variant 'déclare la variable temp (tableau TEMPoraire)
Dim x As Integer 'déclare la variable x (incrément)
Dim lvd As String 'déclare la variable lvd(Liste de Validation de Données)

Set dico = CreateObject("Scripting.Dictionary") 'définit le dictionnaire dico
With Sheets("BDD") 'prend en comte l'onglet "BDD
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne dl de la colonne B
    Set pl = .Range("B2:B" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "BDD"
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    dico(cel.Value) = "" 'alimente le dictionnaire
Next cel 'prochaine cellule de la boucle
temp = dico.keys 'récupère le dictionnaire sans doublons
Call tri(temp, LBound(temp), UBound(temp)) 'lance la procédure de tri croissant du tableau temp
For x = 0 To UBound(temp) 'boucle sur tous les éléments du tableau tri
    lvd = IIf(lvd = "", temp(x) & ",", lvd & temp(x) & ",") 'définit la liste de validation de données
Next x 'prochain élément de la boucle
With Sheets("Request").Range("B1").Validation 'pend en compte la validation de données de la cellule B1 de l'onglet "Request"
    .Delete 'supprime une éventuelle validation existante
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=lvd 'ajoute une validation de données avec la liste lvd
End With 'fin de la prise en compte de...
End Sub


Sub tri(a As Variant, gauc As Integer, droi As Integer) 'tiré du site de Jacques BOISGONTIER [url=http://boisgontierjacques.free.fr/]Formation Excel VBA JB[/url]
Dim ref As Variant
Dim g As Integer, d As Integer
Dim tmp As Variant
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
        tmp = a(g): a(g) = a(d): a(d) = tmp
        g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

With Sheets("BDD") 'prend en comte l'onglet "BDD
    dl = .Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne dl de la colonne B
    Set pl = .Range("B2:B" & dl) 'définit la plage pl
End With 'fin de la prise en compte de l'onglet "BDD"
If Target.Address <> "$B$1" Then Exit Sub 'si le changement a lieu ailleurs qu'en B1, sort de la procédure
If Selection.Cells.Count > 1 Then Exit Sub 'si plusieurs cellules sélectionnées, sort de la procédure
Range("A3").CurrentRegion.ClearContents 'supprime les anciennes données
Set r = pl.Find(Target.Value, , xlValues, xlWhole) 'définit la recherche r
If Not r Is Nothing Then 'condition : si il existe au moins une occrrence trouvée
    pa = r.Address 'définit la première adresse pa
    Do 'exécute
        Set dest = IIf(Range("B3").Value = "", Range("B3"), Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0)) 'définit la cellule de destination (B3 si B3 est vide, sinon en dessous...)
        dest.Offset(0, -1).Value = r.Offset(0, -1).Value 'place le nom de la boite
        dest.Value = r.Value 'place le code barre
        dest.Offset(0, 1).Value = r.Offset(0, 1).Value 'place le contenu
        Set r = pl.FindNext(r) 'redéfinit la recherche r (occurrence suivante)
    Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
End If 'fin de la condition
End Sub