Comment faire une recherche a partie d'un morceau de mot

Le 05/04/2009 à 14:02

j'ai un userform ,il y a un textbox ou je tape le mot a rechercher puis je clic sur rechercher ,il copie toutes le ligne ,qu'il a trouvé le mot dans la colonne 2 de la feuil2,dans la feuil4

ensuite il supprime toutes les ligne vide

ensuite toujours dans cet userform j'ai un listbox qui reprend la liste des mot trouve et copier dans la feuil 4

ex: je tape "avion"il trouve 8 x "avion" dans la col2 de la feuil2 il copie les 8 ligne dans la feuil4 puis met 8x "avion" dans la listbox

puis quand je clic sur un des mot de la listbox il m'affiche les donnees de la ligne du mot choisi (14 colonnes) 14 textboxs

cela fonction bien

mais je voudrai taper juste une partie du mot (ex: "av "au lieu de "avion")et il devrai me trouver("avion,avalanche,aviateur,avarice,......)mais la je sais pas comment faire

pourriez vous me venir en aide svp merci

je vous met mon code on sait jamais ,cela pourrait vous servir

Private Sub ChoixTitre_Click()

Dim NumLigne As Integer

Dim Offert As String

Application.ScreenUpdating = False

NumLigne = ChoixTitre.ListIndex + 3

Set objdvd = Application.ThisWorkbook.Worksheets.Item("feuil4")

Let blnvalidRecherche = True

Let lngNBligne = 3

Dim Genre As String

Application.ScreenUpdating = False

'Détermine le n° de la dernière ligne de la plage

'contenant les titres, sachant que la liste des titres

'commence en ligne 3

'recherche du DVD

If blnvalidRecherche = True Then

Do While objdvd.Cells(lngNBligne, 2) <> ""

If Me.ChoixTitre.Value = objdvd.Cells(lngNBligne, 2) Then

TextBox7 = objdvd.Cells(NumLigne, 1).Value

TextBox8 = objdvd.Cells(NumLigne, 2).Value

TextBox9 = objdvd.Cells(NumLigne, 3).Value

TextBox13 = objdvd.Cells(NumLigne, 4).Value

TextBox14 = objdvd.Cells(NumLigne, 5).Value

TextBox15 = objdvd.Cells(NumLigne, 6).Value

TextBox20 = objdvd.Cells(NumLigne, 7).Value

TextBox21 = objdvd.Cells(NumLigne, 8).Value

TextBox22 = objdvd.Cells(NumLigne, 9).Value

TextBox23 = objdvd.Cells(NumLigne, 10).Value

TextBox27 = objdvd.Cells(NumLigne, 11).Value

TextBox28 = objdvd.Cells(NumLigne, 12).Value

TextBox29 = objdvd.Cells(NumLigne, 13).Value

TextBox31 = objdvd.Cells(NumLigne, 14).Value

End If

Let lngNBligne = lngNBligne + 1

Loop

End If

Application.ScreenUpdating = True

End Sub

Private Sub CommandButton1_Click()

Unload UserForm1

Range("A3:A10000").EntireRow.Delete

MENU.Show

End Sub

Private Sub CommandButton2_Click()

Set objdvd = Application.ThisWorkbook.Worksheets.Item("feuil2")

Let blnvalidRecherche = True

Let lngNBligne = 3

Dim Genre As String

Application.ScreenUpdating = False

If pile = "" Then Exit Sub

'Mise à blanc des zones de texte

Genre = Me.pile

Sheets("feuil4").Activate

'recherche du DVD

If blnvalidRecherche = True Then

Do While objdvd.Cells(lngNBligne, 2) <> ""

If re = objdvd.Cells(lngNBligne, 2) Then

Sheets("feuil4").Cells(lngNBligne, "A").Value = objdvd.Cells(lngNBligne, 1).Value

Sheets("feuil4").Cells(lngNBligne, "B").Value = objdvd.Cells(lngNBligne, 2).Value

Sheets("feuil4").Cells(lngNBligne, "C").Value = objdvd.Cells(lngNBligne, 3).Value

Sheets("feuil4").Cells(lngNBligne, "D").Value = objdvd.Cells(lngNBligne, 4).Value

Sheets("feuil4").Cells(lngNBligne, "E").Value = objdvd.Cells(lngNBligne, 5).Value

Sheets("feuil4").Cells(lngNBligne, "F").Value = objdvd.Cells(lngNBligne, 6).Value

Sheets("feuil4").Cells(lngNBligne, "G").Value = objdvd.Cells(lngNBligne, 7).Value

Sheets("feuil4").Cells(lngNBligne, "H").Value = objdvd.Cells(lngNBligne, 8).Value

Sheets("feuil4").Cells(lngNBligne, "I").Value = objdvd.Cells(lngNBligne, 9).Value

Sheets("feuil4").Cells(lngNBligne, "J").Value = objdvd.Cells(lngNBligne, 10).Value

Sheets("feuil4").Cells(lngNBligne, "K").Value = objdvd.Cells(lngNBligne, 11).Value

Sheets("feuil4").Cells(lngNBligne, "L").Value = objdvd.Cells(lngNBligne, 12).Value

Sheets("feuil4").Cells(lngNBligne, "M").Value = objdvd.Cells(lngNBligne, 13).Value

Sheets("feuil4").Cells(lngNBligne, "N").Value = objdvd.Cells(lngNBligne, 14).Value

End If

Let lngNBligne = lngNBligne + 1

Loop

End If

Dim sel As Variant

Set sel = Sheets("feuil4").Cells.Find(what:=UserForm4.pile.Value)

If Not sel Is Nothing Then

Range("A3:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Else

MsgBox "vous n'avez pas de donnée de ce titre"

Exit Sub

End If

Dim NumDerLigne As Integer

Dim PlageTitres As Range

'Détermine le n° de la dernière ligne de la plage

'contenant les genres, sachant que la liste des genres

'commence en ligne 3

NumDerLigne = Cells(3, 2).End(xlDown).Row

'Définit la plage correspondant à la liste des titres

Set PlageTitres = Sheets("feuil4").Range(Cells(3, 2), Cells(NumDerLigne, 2))

'Mise à jour de la liste ChoixTitre

ChoixTitre.RowSource = PlageTitres.Address

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub compile_Change()

End Sub

Private Sub entretitre_Change()

End Sub

Private Sub pile_Change()

End Sub

Private Sub TextBox10_Change()

End Sub

Private Sub TextBox11_Change()

End Sub

Private Sub TextBox12_Change()

End Sub

Private Sub TextBox13_Change()

End Sub

Private Sub TextBox14_Change()

End Sub

Private Sub TextBox15_Change()

End Sub

Private Sub TextBox18_Change()

End Sub

Private Sub TextBox19_Change()

End Sub

Private Sub TextBox22_Change()

End Sub

Private Sub TextBox23_Change()

End Sub

Private Sub TextBox24_Change()

End Sub

Private Sub TextBox25_Change()

End Sub

Private Sub TextBox26_Change()

End Sub

Private Sub TextBox27_Change()

End Sub

Private Sub TextBox28_Change()

End Sub

Private Sub TextBox29_Change()

End Sub

Private Sub TextBox30_Change()

End Sub

Private Sub TextBox31_Change()

End Sub

Private Sub TextBox32_Change()

End Sub

Private Sub TextBox33_Change()

End Sub

Private Sub TextBox34_Change()

End Sub

Private Sub TextBox35_Change()

End Sub

Private Sub TextBox38_Change()

End Sub

Private Sub TextBox4_Change()

End Sub

Private Sub TextBox5_Change()

End Sub

Private Sub TextBox6_Change()

End Sub

Private Sub TextBox7_Change()

End Sub

Private Sub TextBox8_Change()

End Sub

Private Sub TextBox9_Change()

End Sub

Private Sub UserForm_Click()

End Sub

Le 06/04/2009 à 03:01

bonjour Jaushua,

regarde dans l'aide de VBA l'instruction "LIKE" ça devrait répondre à tes besoins. Par exemple la ligne suivante est vrai.

If "aviation" Like "av*" Then
Le 06/04/2009 à 03:07

Salut le forum

Plein de code sans les balises [Code]

Pas de fichier exemple

https://forum.excel-pratique.com/viewtopic.php?t=6156&highlight=recherche

Mytå

Rechercher des sujets similaires à "comment recherche partie morceau mot"