Recherche d'element similaire dans une BD
Résoluyg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,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
- Recherche d'element similaire dans une BD
- Site similaire a coco - Accueil - Réseaux sociaux
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Remplaçant de Coco : quelles solutions pour tchater gratuitement en ligne ? - Accueil - Réseaux sociaux
- Comment faire une recherche à partir d'une photo - Guide
- Télécharger bd pdf gratuit sans inscription - Forum Loisirs / Divertissements
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
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
