Correction de copie de ligne après recherche de mot

Bonjour,
Est ce que t il remplacer :

If vCellule.Value = mot Then

par :

If left(vCellule.Value,len(mot)) = mot Then

conviens ?
--
http://www.excelabo.net/mpfe/connexion.php
http://dj.joss.free.fr/trombine.htm
Avec plaisir
Philippe.R
"Sylian" <utilisateur@exemple.fr> a écrit dans le message de
news:4705ee9b$0$30927$426a74cc@news.free.fr...

Bnjour
J'essaye de me débrouiller avec l'aide de JB qui ma fournit une routine
excellente mais je bloque en essayant de l'améliorer.
Le but est de trouver un nom dans un colonne et si le nom est trouvé alors
la macro copie la ligne entière en page 2.

A vrai dire la routine fonctionne à merveille mais avec un seul nom.
Imaginons que ma colonne comporte les noms TOTO1; TOTO3 et TOTO7.
J'aimerai que la fonction m'ajoute une ligne pour chaque TOTO trouvé quand
je renseigne le champ "mot" par " TOTO* "
C'est possible ça ?


Voici ma programme ((c)JB pour le début):

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
If vCellule.Value = mot Then
Rows(vCellule.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
End If
Next

End If
End Sub



---------------------------
Cependant la ligne Rows(vCellule.Row).Copy
Sheets(2).[a65000].End(xlUp).Offset(1, 0) ne copie rien du tout... Je dois
pas avoir le bon vocabulaire.
Merci d'avance pour votre aide qui fut vraiment précieuse les fois
précédentes

Salut à toi

remplace :

If vCellule.Value = mot Then

par

If vCellule.Value Like mot & "*" Then

Celà devrait faire

Bnjour
J'essaye de me débrouiller avec l'aide de JB qui ma fournit une routine
excellente mais je bloque en essayant de l'améliorer.
Le but est de trouver un nom dans un colonne et si le nom est trouvé
alors la macro copie la ligne entière en page 2.

A vrai dire la routine fonctionne à merveille mais avec un seul nom.
Imaginons que ma colonne comporte les noms TOTO1; TOTO3 et TOTO7.
J'aimerai que la fonction m'ajoute une ligne pour chaque TOTO trouvé
quand je renseigne le champ "mot" par " TOTO* "
C'est possible ça ?


Voici ma programme ((c)JB pour le début):

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues, LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
If vCellule.Value = mot Then
Rows(vCellule.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
End If
Next

End If
End Sub



---------------------------
Cependant la ligne Rows(vCellule.Row).Copy
Sheets(2).[a65000].End(xlUp).Offset(1, 0) ne copie rien du tout... Je
dois pas avoir le bon vocabulaire.
Merci d'avance pour votre aide qui fut vraiment précieuse les fois
précédentes

Merci Philippe mais rien ne s'affiche dans ma page deux. Pourtant il a
l'air de chercher un peu, peut-être de trouver ...mais aucune ligne
n'est copiée.

Bonjour,
Est ce que t il remplacer :

If vCellule.Value = mot Then

par :

If left(vCellule.Value,len(mot)) = mot Then

conviens ?

Re,
Essaie ceci :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues, LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot)) = mot Then
Rows(vCellule.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", "")
End If
End Sub

--
http://www.excelabo.net/mpfe/connexion.php
http://dj.joss.free.fr/trombine.htm
Avec plaisir
Philippe.R
"Sylian" <utilisateur@exemple.fr> a écrit dans le message de
news:47063f30$0$26772$426a74cc@news.free.fr...

Merci Philippe mais rien ne s'affiche dans ma page deux. Pourtant il a
l'air de chercher un peu, peut-être de trouver ...mais aucune ligne n'est
copiée.

Bonjour,
Est ce que t il remplacer :

If vCellule.Value = mot Then

par :

If left(vCellule.Value,len(mot)) = mot Then

conviens ?

Bonjour et tout d'abord merci

Et bien après test quand je tape "toto" alors il me sort les 3 lignes
comportant repectivement toto / toto2 / toto7 en me mettant "3 mots
trouvés" comme message.
Mais malheureusement si je tape "toto" je ne veux que "toto" et non pas
les 3 lignes incluant toto sans quoi je mettrais "toto*". J'ai essayé
"toto*" ou même "tot*" et la il marque "mot trouvé" (sans s) mais il ne
copie aucune ligne. La routine fonctionne que partiellement ...

--------------------------------------

Re,
Essaie ceci :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues, LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot)) = mot Then
Rows(vCellule.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", "")
End If
End Sub

Re,
Et ainsi :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé",,"M.P.F.E."

Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) - 1)
_
And Right(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf vCellule.Value = mot Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", ""),,"M.P.F.E."
End If
End Sub

va-ce ?
--
http://www.excelabo.net/mpfe/connexion.php
http://dj.joss.free.fr/trombine.htm
Avec plaisir
Philippe.R
"Sylian" <utilisateur@exemple.fr> a écrit dans le message de
news:47066483$0$17223$426a74cc@news.free.fr...

Bonjour et tout d'abord merci

Et bien après test quand je tape "toto" alors il me sort les 3 lignes
comportant repectivement toto / toto2 / toto7 en me mettant "3 mots
trouvés" comme message.
Mais malheureusement si je tape "toto" je ne veux que "toto" et non pas
les 3 lignes incluant toto sans quoi je mettrais "toto*". J'ai essayé
"toto*" ou même "tot*" et la il marque "mot trouvé" (sans s) mais il ne
copie aucune ligne. La routine fonctionne que partiellement ...

--------------------------------------

Re,
Essaie ceci :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot)) = mot Then
Rows(vCellule.Row).Copy Sheets(2).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", "")
End If
End Sub

C'est a genoux que je m'incline !
En tout cas j'essaye de comprendre ! Car crois moi que j'ai bidouillé ta
formule dans tous les sens et il y a encore des choses qui m'échappent.
En tout MERCI beaucoup pour cette astuce !

Et dis-moi si je me trompe mais si je voulais mainteant que mon
asterisque remplace des caractères avant le mot plutôt qu'après ? Par
exmple le mot est *oto il me sorte toto et si le mot est *oto* il me
sirte mes trois lignes avec toto / toto2 / toto3

Il me faut écrire la même formule avec un
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) - 1) _
And Left(mot, 1) = "*"

Ou le remplacement de caractères par * ou ? sont admis différement ?

En tout cas si tu ne peux pas répondre à cette question un peu tordue de
ma part sache que pour l'* derrière le mot ça fonctionne IMPECCABLE
alors encore MERCI

Re,
Et ainsi :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé",,"M.P.F.E."

Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) -
1) _
And Right(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf vCellule.Value = mot Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", ""),,"M.P.F.E."
End If
End Sub

va-ce ?

Bonsoir Sylian,
Allez, réserve tes genuflexions pour Mgr Abile, pas de ça entre nous,
restons simples ;o))))

Pour le plaisir, concernant la question tordue :

Sub nvtab_3()
Dim vCellule As Object, z As Integer
mot = InputBox("Saissez un mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
'si la partie gauche du contenu de la cellule dont la longueur de texte est
égale
' au nombre de caractères de la saisie moins 1 est égale à la même partie
de la
' saisie et que le dernier caractère à droite de la sasie est l'étoile,
alors
' on recopie la cellule vers la feuille de destination
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) - 1)
_
And Right(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf Right(Left(vCellule.Value, Len(mot) - 1), Len(mot) - 2) =
_
Right(Left(mot, Len(mot) - 1), Len(mot) - 2) _
And Right(mot, 1) = "*" And Left(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf vCellule.Value = mot Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", "")
End If
End Sub

devrait coller dans le cas de l'étoile joker placée devant et après (genre
*ot*) ; je te laisse trouver pour le cas de l'étoile devant seulement (*oto)
si nécessaire, tu reviens ; il serait bien étonnant que l'un ou l'autre ne
puisse te dépanner
--
http://www.excelabo.net/mpfe/connexion.php
http://dj.joss.free.fr/trombine.htm
Avec plaisir
Philippe.R
"Sylian" <utilisateur@exemple.fr> a écrit dans le message de
news:47067e62$0$17804$426a74cc@news.free.fr...

C'est a genoux que je m'incline !
En tout cas j'essaye de comprendre ! Car crois moi que j'ai bidouillé ta
formule dans tous les sens et il y a encore des choses qui m'échappent.
En tout MERCI beaucoup pour cette astuce !

Et dis-moi si je me trompe mais si je voulais mainteant que mon asterisque
remplace des caractères avant le mot plutôt qu'après ? Par exmple le mot
est *oto il me sorte toto et si le mot est *oto* il me sirte mes trois
lignes avec toto / toto2 / toto3

Il me faut écrire la même formule avec un
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) - 1) _
And Left(mot, 1) = "*"

Ou le remplacement de caractères par * ou ? sont admis différement ?

En tout cas si tu ne peux pas répondre à cette question un peu tordue de
ma part sache que pour l'* derrière le mot ça fonctionne IMPECCABLE alors
encore MERCI

Re,
Et ainsi :

Sub nvtab()
Dim vCellule As Object
mot = InputBox("mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé",,"M.P.F.E."

Else
For Each vCellule In Selection
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) -
1) _
And Right(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf vCellule.Value = mot Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", ""),,"M.P.F.E."
End If
End Sub

va-ce ?

C'est à moi de conclure ce thread par un grand Merci pour ton aide.
Je vais me dépatouiller avec tout ça. En tout cas c'est étonnant que le
VBA ne connaisse pas le symbole * pour remplacer tous les caractères et
le symbole ? pour remplacer un caractère. Dommage qu'on soit obligé de
faire une routine pour lui expliquer ce que la plupart des programmes de
recherche ont par défaut et ça, depuis, DOS.

Merci encore

Sylian
---------------------------------------------------------------------

Bonsoir Sylian,
Allez, réserve tes genuflexions pour Mgr Abile, pas de ça entre nous,
restons simples ;o))))

Pour le plaisir, concernant la question tordue :

Sub nvtab_3()
Dim vCellule As Object, z As Integer
mot = InputBox("Saissez un mot")
Columns(ActiveCell.Column).Select

Set result = Selection.Find(What:=mot, LookIn:=xlValues,
LookAt:=xlWhole)
If result Is Nothing Then
MsgBox "Non trouvé"
Else
For Each vCellule In Selection
'si la partie gauche du contenu de la cellule dont la longueur de texte
est égale
' au nombre de caractères de la saisie moins 1 est égale à la même
partie de la
' saisie et que le dernier caractère à droite de la sasie est
l'étoile, alors
' on recopie la cellule vers la feuille de destination
If Left(vCellule.Value, Len(mot) - 1) = Left(mot, Len(mot) -
1) _
And Right(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf Right(Left(vCellule.Value, Len(mot) - 1), Len(mot) -
2) = _
Right(Left(mot, Len(mot) - 1), Len(mot) - 2) _
And Right(mot, 1) = "*" And Left(mot, 1) = "*" Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
ElseIf vCellule.Value = mot Then
Rows(vCellule.Row).Copy
Sheets(3).[a65000].End(xlUp).Offset(1, 0)
z = z + 1
End If
Next
MsgBox z & " mot" & IIf(z > 1, "s ", " ") & "trouvé" & IIf(z > 1,
"s", "")
End If
End Sub

devrait coller dans le cas de l'étoile joker placée devant et après
(genre *ot*) ; je te laisse trouver pour le cas de l'étoile devant
seulement (*oto)
si nécessaire, tu reviens ; il serait bien étonnant que l'un ou l'autre
ne puisse te dépanner