Recherche d'element similaire dans une BD
RésoluBonjour,comment allez-vous?
mon soucis est d'effectuer une recherche dans une base de donnée a partir d'un textbox dans un userform. Ce que je veux c'est que le code determine la dimension (len ou nbcar) identifié par "x=len(code)" du texte du textbox identifié par "Code=me.textbox1" et aille chercher dans la premiere cellule identifier par "cible=sheet1.Range("C7")" du tableau,colonne "C" si la dimension de la valeur de la premiere cellule "y=len(cible)" est egale a la dimension du texte du textbox "x".
-Si celle-ci (la dimension du texte du textbox) "x" est superieur a la dimension de la valeur de la premiere cellule "y"(alors on retire (-1) a x jusqu'a ce que x et y soient egaux ,une fois les dimensions sont egales ont determine la nouvelle valeur de code par z=left(code,x) puis on compare si z est egale a cible,si oui le loop s'arrete si non le loop continue d'effectuer le meme processus pour les autres cellules de la colonne "C" pour trouver quelle valeur du tableau est egale a la valeur du textbox "code" sachant qu'a chaque fois qu'on compare la valeur du textbox "code" d'une valeur du tableau on doit mettre a egalite la dimension de x et y puis donner z la nouvelle valeur de "code" en prenant "x" en compte.
Dim cible As Range, code As String, x As Long, y As Long, z As String
Dim ws As Worksheet
On Error Resume Next
Set ws = Sheet1
With ws
Set cible = .Range("C7")
code = Me.TextBox1
x = Len(code)
y = Len(cible)
Do While cible <> Empty 'agir pendant que cible n'est pas vide
If x = y Then'si x est superieur a y
If cible = code Then
Me.Resultat.Caption = cible
End If
ElseIf x > y Then 'si x est superieur a y.
Do Until x = y 'agir jusqu'a ce que x aie la meme dimension que y
x = x - 1 'diminuer x jusqu'a ce que x soit egale a y
Loop
z = Left(code, x)
End If
If z = cible Then ' si z egale a cible Me.Resultat.Caption est egale a z
Me.Resultat.Caption = z
Exit Do 'terminer le loop
Else
End If
Set cible = cible.Offset(1)
Loop
3 réponses
-
-
Bonjour,
Comprends pas trop le but du jeux!
Expliquez ce que vous attendez en finalite?
-
Bonjour,
ce que je veux que le code execute,c est de trouver le prefixe du text du textbox et que ce préfixe existe dans la colonne “C” du tableau
Exemple: le tableau a 4 colonnes
Id,prefixe,longueur,code
imagine que j’inscrive ARG4000 dans le textbox je veux que le code commence par la première cellule du tableau qui est “C7” où “C7” = 98 puis vérifie si la dimension de “ARG4000” qui est 7 et la dimension de “C7” qui est 2 alors il dira si 7 supérieur a 2 diminuons 7 jusqu’à ce qu’il soit egale a 2 puis une fois égale il déterminera z=left(“ARG4000”,2) donc z aura pour valeur “AR” et ira comparer z avec la valeur de la cellule “C7”
if AR=98 then dire oui mais si non continuer le meme processus pour chaque cellule du tableau pour trouver si le mot inscris au textbox a son prefixe au tableau colonne “C”
-
-
Re,
Si j'ai bien compris
textbox =ARG4000 recherche dans Colonne C si il y a un prefixe qui serait inclu dans le texte ARG4000 ex: ARG40
Plutot que de faire des boucles sur la longueur, un simple test like fera l'affaire
-
Suite:
Sub LoadTextbox() Dim code As String Dim ws As Worksheet 'On Error Resume Next If Me.TextBox1 <> "" Then Set ws = Sheet1 code = Me.TextBox1 With ws Derlig = .Range("B" & .Rows.Count).End(xlUp).Row Set Plage = .Range("B7:B" & Derlig) For Each Cel In Plage If code Like Cel & "*" Then Me.Resultat.Caption = Cel Exit For End If Next End With End If End Sub -
@f894009
Je vais tester le code.
-
@f894009
Suite: code plus complet
Sub LoadTextbox() Dim code As String Dim ws As Worksheet Dim Plage As Range Dim cel As Range 'On Error Resume Next If Me.TextBox1 <> "" Then Set ws = Sheet1 code = Me.TextBox1 With ws Set Plage = .Range("B7:B" & .Range("B" & .Rows.Count).End(xlUp).Row) For Each cel In Plage If code Like cel & "*" Then Me.Resultat.Caption = cel Exit For End If Next End With End If Set ws = Nothing Set Plahe = Nothing End Sub -
@f894009
Merci infiniment c est la première fois que j utilise la fonction #like et ca marche à merveille
-
Contributeur
-
