Petite base de donnees et recherche

choupi_nette

XLDnaute Occasionnel
Bonjour le forum,
J'ai mis en piece jointe mon fichier et je vous pose ma question:

J'ai une mini base de donnee onglet BDD

Dans un onglet request, j'aimerai que quand je tape l'un des codes a barres il me sorte le contenu de la boite (voir la reponse attendue en vert dans mon onglet request)

Est il facile de faire ca ?
info ma BDD est assez longue...

Merci pour votre aide
 

Pièces jointes

  • bank.xls
    16 KB · Affichages: 49
  • bank.xls
    16 KB · Affichages: 49
  • bank.xls
    16 KB · Affichages: 50

Spinzi

XLDnaute Impliqué
Re : Petite base de donnees et recherche

Bonjour choupi_nette,

tu trouveras ci joint une ébauche de travail, mais qui doit normalement fonctionner.
A tester, comme on dit chez nous !

Bonne journée
 

Pièces jointes

  • Essai Renvoi d'infos.xls
    22.5 KB · Affichages: 54

Robert

XLDnaute Barbatruc
Repose en paix
Re : Petite base de donnees et recherche

Bonjour le fil, bonjour le forum,

En pièce jointe ton fichier modifié. À l'ouverture du classeur le code récupère les code barres de la base de données et te propose une liste de validation de données triée par ordre croissant dans la cellule B2 de l'onglet Request. Ça evite de taper un mauvais code ou d'avoir à se souvenir de tous les codes...
Le code :
Code:
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
Ensuite c'est l'événement Change qui fait le reste :
Code:
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
le fichier :
 

Pièces jointes

  • Choupi_nette_v01.xls
    36 KB · Affichages: 59
  • Choupi_nette_v01.xls
    36 KB · Affichages: 59
  • Choupi_nette_v01.xls
    36 KB · Affichages: 57

Robert

XLDnaute Barbatruc
Repose en paix
Re : Petite base de donnees et recherche

Bonjour le fil, bonjour le forum,

@Spinzi. Tu plaisantes ! Mon grand regret c'est d'être nul en formules c'est pour ça que je me tapes de ligne de code... Une solution en formule est très souvent plus efficace que le VBA !
 

Spinzi

XLDnaute Impliqué
Re : Petite base de donnees et recherche

@Robert : oui mais quand on touche aussi profond aux codes en VBA, je ne pense pas qu'un Index Equiv ou un Sommprod soit un obstable à la création d'un fichier ... ;)

Ravi d'avoir pu vous aider.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Petite base de donnees et recherche

Bonjour le fil, bonjour le forum,

Spinzi, tu me crois si je te dis que je ne sais pas utiliser Sommprod et que quand je réussi ue formule avec Index et Equiv je suis fier comme si j'avais accompli une grande tâche... ? Je suis toujours peplexe quand je vois ce que vous faites avec des formules...
 

Discussions similaires

Statistiques des forums

Discussions
312 673
Messages
2 090 784
Membres
104 664
dernier inscrit
jth