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
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
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
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
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
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
Bonjour,
Est ce que t il remplacer :
If vCellule.Value = mot Then
par :
If left(vCellule.Value,len(mot)) = mot Then
conviens ?
Bonjour,
Est ce que t il remplacer :
If vCellule.Value = mot Then
par :
If left(vCellule.Value,len(mot)) = mot Then
conviens ?
Bonjour,
Est ce que t il remplacer :
If vCellule.Value = mot Then
par :
If left(vCellule.Value,len(mot)) = mot Then
conviens ?
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 ?
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 ?
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
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,
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
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
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
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 ?
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 ?
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 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 MERCIRe,
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 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 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 MERCIRe,
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
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
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