Select phrase après un mot

Y'a pas de mal.
Je te demande un peu de temps (disons une petite heure).

@d'taleur
FxM

Excuses...

Clarifions la situation :

Où sont tes données d'entrée :
- y a-t-il UN fichier ou PLUSIEURS fichiers ? UN FICHIER
-> son nom est ... FichierNimporte.xls
- y a-t-il UNE feuille ou PLUSIEURS feuilles ? UNE FEUILLE
-> son nom est ...Feuil1
- y a-t-il UNE zone ou PLUSIEURS zones : UNE PLAGE (par ex. A1:C2000)
-> leur(s) adresse(s) est(sont) ...

Où voudrais-tu les données en sortie :
nom de feuille : .... LA MEME (Feuil1)
Colonne E : tout ce qui démarre par "Loi" : OUI
Colonne F : tout ce qui démarre par "Réglement" : OUI
Colonne G : tout ce qui démarre par "Décret" : OUI
S'il y en a d'autre, c'est le moment ou jamais de le dire !
-> A partir de quelle ligne doit-on écrire (titre en ligne 1?) LIGNE 1

(pas de titre)
yvan

CA MARCHE DU TONNERRE DE ZEUS !!!!
Merci à tous
Super, super forum et forumers !!
Tiens si j'étais une nana, vous mériteriez une pi... mais je m'égare... :o)
!!!
Encore MErci
yvan
A bientot pour une nouvelle excelente aventure
----------------

"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
#1xpMJ2vEHA.536@TK2MSFTNGP11.phx.gbl...

Voici le résultat des courses.

Dans le classeur en question :
Alt-F11 | insertion | module

Sub test()
'feuille
feu_arr = "feuil1"
'cellules d'entrée
plage_cel = "A1:C2000"
'textes à chercher
arr_texte = Array("loi", "réglement", "décret")

'avec la feuille
With Sheets(feu_arr)
'parcourir toutes les cellules
For Each cel In .Range(plage_cel)
'si elle n'est pas vide
If Not IsEmpty(cel) Then
'quel est le contenu
celT = cel.Text
'parcourir la liste des textes à chercher
For a = 0 To UBound(arr_texte)
'pos = 0 = texte absent, sinon position du texte
pos = InStr(1, UCase(celT), UCase(arr_texte(a)))
If pos > 0 Then
'dernière ligne
lig = .Cells(65536, 5 + a).End(xlUp).Row
'particularité pour la 1ère ligne
If .Cells(lig, 5 + a) = "" Then lig = 0
'extraire et placer
.Cells(lig + 1, 5 + a) = Mid(celT, pos, Len(celT))
Exit For
End If
Next a
End If
Next cel
End With
End Sub



Voici la macro dont je me suis servi pour remplir des fausses données :

Sub rnd4()
Randomize
feu_arr = "feuil1"
plage_cel = "A1:C2000"
arr_texte = Array("loi", "réglement", "décret")

With Sheets(feu_arr)
For Each cel In Range(plage_cel)
alea = 3 * Rnd()
st1 = "toto toto "
st2 = " du 12 de cne kahd zuh "
On Error Resume Next
txt = Mid(st1, Rnd() * Len(st1), Rnd() * Len(st1)) &
arr_texte(Int(alea)) & Mid(st2, Rnd() * Len(st2), Rnd() * Len(st2))
On Error GoTo 0
cel.Value = txt
Next cel
End With
End Sub

Le tout testé sous XL2K/Win98SE.

@+
FxM

Excuses...

Clarifions la situation :

Où sont tes données d'entrée :
- y a-t-il UN fichier ou PLUSIEURS fichiers ? UN FICHIER
-> son nom est ... FichierNimporte.xls
- y a-t-il UNE feuille ou PLUSIEURS feuilles ? UNE FEUILLE
-> son nom est ...Feuil1
- y a-t-il UNE zone ou PLUSIEURS zones : UNE PLAGE (par ex. A1:C2000)
-> leur(s) adresse(s) est(sont) ...

Où voudrais-tu les données en sortie :
nom de feuille : .... LA MEME (Feuil1)
Colonne E : tout ce qui démarre par "Loi" : OUI
Colonne F : tout ce qui démarre par "Réglement" : OUI
Colonne G : tout ce qui démarre par "Décret" : OUI
S'il y en a d'autre, c'est le moment ou jamais de le dire !
-> A partir de quelle ligne doit-on écrire (titre en ligne 1?) LIGNE 1

(pas de titre)
yvan

Avec tes données brutes en A2:Ax
Des titres en A1;E1;F1;G1 (c'est une absolue nécessité pour bien structurer une
BD)
Extraction des Lois en E2:Ex, des Règlements en F2:Fx et des Décrets en G2:Gx

Sub zzz()
Application.ScreenUpdating = False
Set plg = Range("A2:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeVisible)
On Error Resume Next
With [A:A]
.AutoFilter Field:=1, Criteria1:="=*Loi*"
[plg].Copy [E2]
.AutoFilter Field:=1, Criteria1:="=*Règlement*"
[plg].Copy [F2]
.AutoFilter Field:=1, Criteria1:="=*Décret*"
[plg].Copy [G2]
.AutoFilter
End With
For Each c In Range("E2:E" & [E65536].End(3).Row)
c.Value = Mid(c, Application.Find("Loi", c), 9 ^ 9)
Next
For Each c In Range("F2:F" & [F65536].End(3).Row)
c.Value = Mid(c, Application.Find("Règlement", c), 9 ^ 9)
Next
For Each c In Range("G2:G" & [G65536].End(3).Row)
c.Value = Mid(c, Application.Find("Décret", c), 9 ^ 9)
Next
End Sub

PS : L'utilisation d'un filtre accélère le traitement en limitant au minimum les
boucles
AV

Voici le résultat des courses.

Dans le classeur en question :
Alt-F11 | insertion | module

Sub test()
'feuille
feu_arr = "feuil1"
'cellules d'entrée
plage_cel = "A1:C2000"
'textes à chercher
arr_texte = Array("loi", "réglement", "décret")

'avec la feuille
With Sheets(feu_arr)
'parcourir toutes les cellules
For Each cel In .Range(plage_cel)
'si elle n'est pas vide
If Not IsEmpty(cel) Then
'quel est le contenu
celT = cel.Text
'parcourir la liste des textes à chercher
For a = 0 To UBound(arr_texte)
'pos = 0 = texte absent, sinon position du texte
pos = InStr(1, UCase(celT), UCase(arr_texte(a)))
If pos > 0 Then
'dernière ligne
lig = .Cells(65536, 5 + a).End(xlUp).Row
'particularité pour la 1ère ligne
If .Cells(lig, 5 + a) = "" Then lig = 0
'extraire et placer
.Cells(lig + 1, 5 + a) = Mid(celT, pos, Len(celT))
Exit For
End If
Next a
End If
Next cel
End With
End Sub



Voici la macro dont je me suis servi pour remplir des fausses données :

Sub rnd4()
Randomize
feu_arr = "feuil1"
plage_cel = "A1:C2000"
arr_texte = Array("loi", "réglement", "décret")

With Sheets(feu_arr)
For Each cel In Range(plage_cel)
alea = 3 * Rnd()
st1 = "toto toto "
st2 = " du 12 de cne kahd zuh "
On Error Resume Next
txt = Mid(st1, Rnd() * Len(st1), Rnd() * Len(st1)) &
arr_texte(Int(alea)) & Mid(st2, Rnd() * Len(st2), Rnd() * Len(st2))
On Error GoTo 0
cel.Value = txt
Next cel
End With
End Sub

Le tout testé sous XL2K/Win98SE.

@+
FxM

Excuses...

Clarifions la situation :

Où sont tes données d'entrée :
- y a-t-il UN fichier ou PLUSIEURS fichiers ? UN FICHIER
-> son nom est ... FichierNimporte.xls
- y a-t-il UNE feuille ou PLUSIEURS feuilles ? UNE FEUILLE
-> son nom est ...Feuil1
- y a-t-il UNE zone ou PLUSIEURS zones : UNE PLAGE (par ex. A1:C2000)
-> leur(s) adresse(s) est(sont) ...

Où voudrais-tu les données en sortie :
nom de feuille : .... LA MEME (Feuil1)
Colonne E : tout ce qui démarre par "Loi" : OUI
Colonne F : tout ce qui démarre par "Réglement" : OUI
Colonne G : tout ce qui démarre par "Décret" : OUI
S'il y en a d'autre, c'est le moment ou jamais de le dire !
-> A partir de quelle ligne doit-on écrire (titre en ligne 1?) LIGNE 1

(pas de titre)
yvan

Je plaisantais, bien sûûûûûrr... Merci en tous cas.

"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
#0ZpMp2vEHA.3144@TK2MSFTNGP15.phx.gbl...

Après les cahuètes et 1/2 cahuètes, les petits et gros bisoux, les
poutoux dans l'oreille, voici les turluttes [Non, chers ami(e)s
Canadiens, ce n'est pas la même chose que par chez vous :o) ]

Yvan, t'es gentil tout plein mais euh ... (comment dire?) faut pas
t'égarer :o)

@+
FxM

CA MARCHE DU TONNERRE DE ZEUS !!!!
Merci à tous
Super, super forum et forumers !!
Tiens si j'étais une nana, vous mériteriez une pi... mais je m'égare...
:o)

!!!
Encore MErci
yvan
A bientot pour une nouvelle excelente aventure
----------------

"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
#1xpMJ2vEHA.536@TK2MSFTNGP11.phx.gbl...

Voici le résultat des courses.

Dans le classeur en question :
Alt-F11 | insertion | module

Sub test()
'feuille
feu_arr = "feuil1"
'cellules d'entrée
plage_cel = "A1:C2000"
'textes à chercher
arr_texte = Array("loi", "réglement", "décret")

'avec la feuille
With Sheets(feu_arr)
'parcourir toutes les cellules
For Each cel In .Range(plage_cel)
'si elle n'est pas vide
If Not IsEmpty(cel) Then
'quel est le contenu
celT = cel.Text
'parcourir la liste des textes à chercher
For a = 0 To UBound(arr_texte)
'pos = 0 = texte absent, sinon position du texte
pos = InStr(1, UCase(celT), UCase(arr_texte(a)))
If pos > 0 Then
'dernière ligne
lig = .Cells(65536, 5 + a).End(xlUp).Row
'particularité pour la 1ère ligne
If .Cells(lig, 5 + a) = "" Then lig = 0
'extraire et placer
.Cells(lig + 1, 5 + a) = Mid(celT, pos, Len(celT))
Exit For
End If
Next a
End If
Next cel
End With
End Sub



Voici la macro dont je me suis servi pour remplir des fausses données :

Sub rnd4()
Randomize
feu_arr = "feuil1"
plage_cel = "A1:C2000"
arr_texte = Array("loi", "réglement", "décret")

With Sheets(feu_arr)
For Each cel In Range(plage_cel)
alea = 3 * Rnd()
st1 = "toto toto "
st2 = " du 12 de cne kahd zuh "
On Error Resume Next
txt = Mid(st1, Rnd() * Len(st1), Rnd() * Len(st1)) &
arr_texte(Int(alea)) & Mid(st2, Rnd() * Len(st2), Rnd() * Len(st2))
On Error GoTo 0
cel.Value = txt
Next cel
End With
End Sub

Le tout testé sous XL2K/Win98SE.

@+
FxM

Excuses...

Clarifions la situation :

Où sont tes données d'entrée :
- y a-t-il UN fichier ou PLUSIEURS fichiers ? UN FICHIER
-> son nom est ... FichierNimporte.xls
- y a-t-il UNE feuille ou PLUSIEURS feuilles ? UNE FEUILLE
-> son nom est ...Feuil1
- y a-t-il UNE zone ou PLUSIEURS zones : UNE PLAGE (par ex. A1:C2000)
-> leur(s) adresse(s) est(sont) ...

Où voudrais-tu les données en sortie :
nom de feuille : .... LA MEME (Feuil1)
Colonne E : tout ce qui démarre par "Loi" : OUI
Colonne F : tout ce qui démarre par "Réglement" : OUI
Colonne G : tout ce qui démarre par "Décret" : OUI
S'il y en a d'autre, c'est le moment ou jamais de le dire !
-> A partir de quelle ligne doit-on écrire (titre en ligne 1?) LIGNE 1

(pas de titre)
yvan

Même le dimanche en période de fêtes ... y m'énerve ;o))))

@+
FxM

Avec tes données brutes en A2:Ax
Des titres en A1;E1;F1;G1 (c'est une absolue nécessité pour bien structurer une
BD)
Extraction des Lois en E2:Ex, des Règlements en F2:Fx et des Décrets en G2:Gx

Sub zzz()
Application.ScreenUpdating = False
Set plg = Range("A2:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeVisible)
On Error Resume Next
With [A:A]
.AutoFilter Field:=1, Criteria1:="=*Loi*"
[plg].Copy [E2]
.AutoFilter Field:=1, Criteria1:="=*Règlement*"
[plg].Copy [F2]
.AutoFilter Field:=1, Criteria1:="=*Décret*"
[plg].Copy [G2]
.AutoFilter
End With
For Each c In Range("E2:E" & [E65536].End(3).Row)
c.Value = Mid(c, Application.Find("Loi", c), 9 ^ 9)
Next
For Each c In Range("F2:F" & [F65536].End(3).Row)
c.Value = Mid(c, Application.Find("Règlement", c), 9 ^ 9)
Next
For Each c In Range("G2:G" & [G65536].End(3).Row)
c.Value = Mid(c, Application.Find("Décret", c), 9 ^ 9)
Next
End Sub

PS : L'utilisation d'un filtre accélère le traitement en limitant au minimum les
boucles
AV

Bonjour,

Une possibilité avec une fonction perso VBA qui peut (en utilisant son deuxième
argument) soit chercher n'importe lequel de tes mots clés et renvoyer le
résultat trouvé (ou une chaîne vide si aucune correspondance) soit chercher un
mot clé en particulier (peut peut-être faciliter ton rangement par colonnes).
Dans un module standard (et à condition d'utiliser Excel 2000 ou + récent) :

'============= Function LoisAndCo(cell, Optional motclé = -1)
Dim Arr, Tblo, i&

Arr = Array("Loi", "Décret", "Règlement")
Select Case motclé
Case 0 To 2 '0=Loi, 1=Décret, 2=Règlement
Tblo = Split(cell, Arr(motclé))
If UBound(Tblo) = 0 Then
LoisAndCo = "": Exit Function
Else: i = motclé
End If
Case Else
For i = LBound(Arr) To UBound(Arr)
Tblo = Split(cell, Arr(i))
If UBound(Tblo) > 0 Then Exit For
Next i
If UBound(Tblo) = 0 Then
LoisAndCo = "": Exit Function
End If
End Select

LoisAndCo = Arr(i) & Split(cell, Arr(i))(UBound(Split(cell, Arr(i))))

End Function
'=============
FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://frederic.sigonneau.free.fr
Si votre question sur Excel est urgente, évitez ma bal !

Je prends le mot Loi, réglement, Décret... comme critères.


"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
e2oa5a1vEHA.1404@TK2MSFTNGP11.phx.gbl...

... et qu'as-tu pris comme critère de recherche ?
Autrement dit, qu'est ce que permet de détecter qu'il ne faut pas
prendre "dfg df wfw " ?

@+
FxM

Bonjour,
La phrase est du type "dfg df wfw Loi n° 23/23 art. 3"
J'aimerais avoir "Loi n° 23/23 art. 3" dans une autre cellule.



"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
uYFm6U0vEHA.2316@TK2MSFTNGP15.phx.gbl...

Bonjour à tous,
Je fais la recherche d'un mot ds une plage de cells. Je trouve le mot
mais j'aimerais copier le mot avec le restant de la phrase... comment
faire.
Help !!!
Merci

Bonjour Yvan,

Et serait-il indiscret de savoir où est cette phrase ?
Si tu as trouvé le mot, la cellule ne contient-elle que ce mot, la
phrase, un groupe de phrase, que sais-je encore ??

@+
FxM

Bonjour,
Essaie en placant un bouton de commande sur ta feuille et dans
le code VBA de la feuille mets les lignes suivantes :

Public Cellule As Range
Dim PhraseTrouve As Byte, CellE As String, CellF As String, CellG As String

Dans mon exemple le bouton s'appelle CommandButton1

Sub CommandButton1_Click()
CellE = "E1"
CellF = "F1"
CellG = "G1"
Worksheets("Feuil1").Range("A1:C2000").Select
For Each Cellule In Selection
CellE = CopiePhrase("Loi", CellE)
CellF = CopiePhrase("Règlement", CellF)
CellG = CopiePhrase("Décret", CellG)
Next
End Sub

Function CopiePhrase(Mot As String, ByVal Cell As String) As String
Dim WordFound As Byte
WordFound = InStr(1, Cellule, Mot)
If WordFound > 0 Then
Worksheets("Feuil1").Range(Cell) = Mid(Cellule, WordFound)
Cell = Left(Cell, 1) & CInt(Right(Cell, Len(Cell) - 1)) + 1
End If
CopiePhrase = Cell
End Function

Même le dimanche en période de fêtes ... y m'énerve ;o))))

Boff ...
que m'apercois-je donque à la relecture ?
Ses données seraient en A1:Cx ?
Bon ...laissons réagir

AV

Question plat qui se mange froid, j'y connais rien...
Mais c'est EXCELLEMMENT HOT !!
A+
Yvan

"sabatier" <biscotteUnScudJpsabatdelaile@wanadoo.fr> a écrit dans le message
de news: O5#xLz2vEHA.1400@TK2MSFTNGP11.phx.gbl...

ben, pourquoi, françois-xavier, ce "euh...faut pas t'égarer"?
si tu étais venu à marseille, tu aurais toi aussi profité de celle que
nous

a faite la charmante femme de Laurent D, bien aidée en cela par l'épouse
de

Luc, le pote à Laurent...
attends, je pose la question aux connaisseurs que sont Pierre, Jièl,
Jean-Pascal (je ne m'adresse pas à Robert qui, c'est lui qui l'a dit,
n'aime

pas manger épicé) ; allez, dites-leur à ces esprits tordus qu'elle était
vraiment bonne cette piperade...
jps

"FxM" <nullos@greuchmeu.ici> a écrit dans le message de
news:%230ZpMp2vEHA.3144@TK2MSFTNGP15.phx.gbl...

Après les cahuètes et 1/2 cahuètes, les petits et gros bisoux, les
poutoux dans l'oreille, voici les turluttes [Non, chers ami(e)s
Canadiens, ce n'est pas la même chose que par chez vous :o) ]

Yvan, t'es gentil tout plein mais euh ... (comment dire?) faut pas
t'égarer :o)

@+
FxM

CA MARCHE DU TONNERRE DE ZEUS !!!!
Merci à tous
Super, super forum et forumers !!
Tiens si j'étais une nana, vous mériteriez une pi... mais je
m'égare...

:o)

!!!
Encore MErci
yvan
A bientot pour une nouvelle excelente aventure
----------------

"FxM" <nullos@greuchmeu.ici> a écrit dans le message de news:
#1xpMJ2vEHA.536@TK2MSFTNGP11.phx.gbl...

Voici le résultat des courses.

Dans le classeur en question :
Alt-F11 | insertion | module

Sub test()
'feuille
feu_arr = "feuil1"
'cellules d'entrée
plage_cel = "A1:C2000"
'textes à chercher
arr_texte = Array("loi", "réglement", "décret")

'avec la feuille
With Sheets(feu_arr)
'parcourir toutes les cellules
For Each cel In .Range(plage_cel)
'si elle n'est pas vide
If Not IsEmpty(cel) Then
'quel est le contenu
celT = cel.Text
'parcourir la liste des textes à chercher
For a = 0 To UBound(arr_texte)
'pos = 0 = texte absent, sinon position du texte
pos = InStr(1, UCase(celT), UCase(arr_texte(a)))
If pos > 0 Then
'dernière ligne
lig = .Cells(65536, 5 + a).End(xlUp).Row
'particularité pour la 1ère ligne
If .Cells(lig, 5 + a) = "" Then lig = 0
'extraire et placer
.Cells(lig + 1, 5 + a) = Mid(celT, pos, Len(celT))
Exit For
End If
Next a
End If
Next cel
End With
End Sub



Voici la macro dont je me suis servi pour remplir des fausses données
:

Sub rnd4()
Randomize
feu_arr = "feuil1"
plage_cel = "A1:C2000"
arr_texte = Array("loi", "réglement", "décret")

With Sheets(feu_arr)
For Each cel In Range(plage_cel)
alea = 3 * Rnd()
st1 = "toto toto "
st2 = " du 12 de cne kahd zuh "
On Error Resume Next
txt = Mid(st1, Rnd() * Len(st1), Rnd() * Len(st1)) &
arr_texte(Int(alea)) & Mid(st2, Rnd() * Len(st2), Rnd() * Len(st2))
On Error GoTo 0
cel.Value = txt
Next cel
End With
End Sub

Le tout testé sous XL2K/Win98SE.

@+
FxM

Excuses...

Clarifions la situation :

Où sont tes données d'entrée :
- y a-t-il UN fichier ou PLUSIEURS fichiers ? UN FICHIER
-> son nom est ... FichierNimporte.xls
- y a-t-il UNE feuille ou PLUSIEURS feuilles ? UNE FEUILLE
-> son nom est ...Feuil1
- y a-t-il UNE zone ou PLUSIEURS zones : UNE PLAGE (par ex.
A1:C2000)

-> leur(s) adresse(s) est(sont) ...

Où voudrais-tu les données en sortie :
nom de feuille : .... LA MEME (Feuil1)
Colonne E : tout ce qui démarre par "Loi" : OUI
Colonne F : tout ce qui démarre par "Réglement" : OUI
Colonne G : tout ce qui démarre par "Décret" : OUI
S'il y en a d'autre, c'est le moment ou jamais de le dire !
-> A partir de quelle ligne doit-on écrire (titre en ligne 1?) LIGNE
1

(pas de titre)
yvan