Mettre en "Gras" une partie de texte trouvée avec ".Find"
3 réponses
Syl
Bonjour!
Voici mon probl=E8me, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouv=E9e
en Gras. Pr=E9sentement j'utilise le code "c.font.bold =3D True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit appara=EEtre en gras c'est seulement la chaine de
caract=E8res qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au crit=E8re
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c =3D .Find(txtAppareil.Value, LookIn:=3DxlValues)
If Not c Is Nothing Then
FirstAddress =3D c.Address
j =3D 0
Do
j =3D j + 1
myArray(j, 1) =3D c.Address
c.font.bold =3D True
'Debug.Print myArray(j, 1)
Set c =3D .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Xavier POWAGA
voici une autre solution avec la fonction RegExp
Sub EncadreMot() On Error Resume Next
Dim RE As Object, Matches As Object Dim match As Object, c As Range Set RE = New RegExp RE.Pattern = TextRecherche RE.Global = True RE.IgnoreCase = False Set Matches = RE.Execute(Cells(ligne,colonne).Value) If Matches.Count > 0 Then For Each match In Matches Cells(ligne,colonne).Characters(Start:=match.FirstIndex + 1, Length:=match.Length).Font.FontStyle = "Gras" Next End If Next
End Sub "Syl" a écrit dans le message de news:
Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With
Merci.
voici une autre solution avec la fonction RegExp
Sub EncadreMot()
On Error Resume Next
Dim RE As Object, Matches As Object
Dim match As Object, c As Range
Set RE = New RegExp
RE.Pattern = TextRecherche
RE.Global = True
RE.IgnoreCase = False
Set Matches = RE.Execute(Cells(ligne,colonne).Value)
If Matches.Count > 0 Then
For Each match In Matches
Cells(ligne,colonne).Characters(Start:=match.FirstIndex + 1,
Length:=match.Length).Font.FontStyle = "Gras"
Next
End If
Next
End Sub
"Syl" <syl.news2@sympatico.ca> a écrit dans le message de news:
1140364115.258556.183960@g47g2000cwa.googlegroups.com...
Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Dim RE As Object, Matches As Object Dim match As Object, c As Range Set RE = New RegExp RE.Pattern = TextRecherche RE.Global = True RE.IgnoreCase = False Set Matches = RE.Execute(Cells(ligne,colonne).Value) If Matches.Count > 0 Then For Each match In Matches Cells(ligne,colonne).Characters(Start:=match.FirstIndex + 1, Length:=match.Length).Font.FontStyle = "Gras" Next End If Next
End Sub "Syl" a écrit dans le message de news:
Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With
Merci.
michdenis
Bonjour Syl,
'------------------------------- Sub test()
Dim C As Range, L As Integer Dim J As Integer With KBB With .Range("A3:A" & .Range("E65000").End(xlUp).Row) Set C = .Find(txtAppareil.Value, LookIn:=xlValues) L = Len(Trim(txtAppareil.Value)) If Not C Is Nothing Then FirstAddress = C.Address J = 0 Do J = J + 1 MyArray(J, 1) = C.Address C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With 'pour copier la liste des adresse vers la cellule G1 de la présente feuille. On Error Resume Next .Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray) End With End Sub '-------------------------------
Salutations!
"Syl" a écrit dans le message de news: Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With
Merci.
Bonjour Syl,
'-------------------------------
Sub test()
Dim C As Range, L As Integer
Dim J As Integer
With KBB
With .Range("A3:A" & .Range("E65000").End(xlUp).Row)
Set C = .Find(txtAppareil.Value, LookIn:=xlValues)
L = Len(Trim(txtAppareil.Value))
If Not C Is Nothing Then
FirstAddress = C.Address
J = 0
Do
J = J + 1
MyArray(J, 1) = C.Address
C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
'pour copier la liste des adresse vers la cellule G1 de la présente feuille.
On Error Resume Next
.Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray)
End With
End Sub
'-------------------------------
Salutations!
"Syl" <syl.news2@sympatico.ca> a écrit dans le message de news: 1140364115.258556.183960@g47g2000cwa.googlegroups.com...
Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Dim C As Range, L As Integer Dim J As Integer With KBB With .Range("A3:A" & .Range("E65000").End(xlUp).Row) Set C = .Find(txtAppareil.Value, LookIn:=xlValues) L = Len(Trim(txtAppareil.Value)) If Not C Is Nothing Then FirstAddress = C.Address J = 0 Do J = J + 1 MyArray(J, 1) = C.Address C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With 'pour copier la liste des adresse vers la cellule G1 de la présente feuille. On Error Resume Next .Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray) End With End Sub '-------------------------------
Salutations!
"Syl" a écrit dans le message de news: Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With
Merci.
michdenis
Bonjour Syl,
Je ne t'ai pas envoyé la procédure corrigée... la voici !
'------------------------------ Sub test()
Dim C As Range, L As Integer Dim J As Long, FirstAddress As String Dim MyArray()
With KBB With .Range("A3:A" & .Range("E65000").End(xlUp).Row) Set C = .Find(txtAppareil.Value, LookIn:=xlValues) L = Len(Trim(txtAppareil.Value)) If Not C Is Nothing Then FirstAddress = C.Address J = 1 Do ReDim Preserve MyArray(1 To 1, 1 To J) MyArray(1, J) = C.Address C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True J = J + 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With 'pour copier la liste des adresse vers la cellule G1 de la présente feuille. On Error Resume Next .Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray) End With End Sub '------------------------------
Salutations!
"Syl" a écrit dans le message de news: Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With
Merci.
Bonjour Syl,
Je ne t'ai pas envoyé la procédure corrigée...
la voici !
'------------------------------
Sub test()
Dim C As Range, L As Integer
Dim J As Long, FirstAddress As String
Dim MyArray()
With KBB
With .Range("A3:A" & .Range("E65000").End(xlUp).Row)
Set C = .Find(txtAppareil.Value, LookIn:=xlValues)
L = Len(Trim(txtAppareil.Value))
If Not C Is Nothing Then
FirstAddress = C.Address
J = 1
Do
ReDim Preserve MyArray(1 To 1, 1 To J)
MyArray(1, J) = C.Address
C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True
J = J + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
'pour copier la liste des adresse vers la cellule G1 de la présente feuille.
On Error Resume Next
.Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray)
End With
End Sub
'------------------------------
Salutations!
"Syl" <syl.news2@sympatico.ca> a écrit dans le message de news: 1140364115.258556.183960@g47g2000cwa.googlegroups.com...
Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With
Je ne t'ai pas envoyé la procédure corrigée... la voici !
'------------------------------ Sub test()
Dim C As Range, L As Integer Dim J As Long, FirstAddress As String Dim MyArray()
With KBB With .Range("A3:A" & .Range("E65000").End(xlUp).Row) Set C = .Find(txtAppareil.Value, LookIn:=xlValues) L = Len(Trim(txtAppareil.Value)) If Not C Is Nothing Then FirstAddress = C.Address J = 1 Do ReDim Preserve MyArray(1 To 1, 1 To J) MyArray(1, J) = C.Address C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True J = J + 1 Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> FirstAddress End If End With 'pour copier la liste des adresse vers la cellule G1 de la présente feuille. On Error Resume Next .Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray) End With End Sub '------------------------------
Salutations!
"Syl" a écrit dans le message de news: Bonjour!
Voici mon problème, je fais une recherche dans du texte avec la fonction .Find par la suite je doit mettre la partie de texte trouvée en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci met le contenu de toute la cellule en gras. Ce qui doit apparaître en gras c'est seulement la chaine de caractères qui se trouve dans la variable txtAppareil.Value.
'Enregistre dans la variable tableau les adresses de tous les enregistrement qui 'correspondent au critère With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row) Set c = .Find(txtAppareil.Value, LookIn:=xlValues) If Not c Is Nothing Then FirstAddress = c.Address j = 0 Do j = j + 1 myArray(j, 1) = c.Address c.font.bold = True 'Debug.Print myArray(j, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> FirstAddress End If End With