Microsoft 365 Fonction Replace

ODB

XLDnaute Nouveau
Bonjour à Tous,
Voilà le problème que j'essaye de résoudre:
Dans une feuille excel, j'ai une liste d'allergènes
Dans une autre feuille (même classeur), j'ai une liste de produits et leurs ingrédients. Certains de ces ingrédients sont des allergènes.
Je dois détecter si ces allergènes sont présents dans les produits et, s'ils existent, les mettre en gras afin qu'ils soient plus facilement repérables.
Pour l'instant je bloque car le composé allergène est détecté mais pas mis en gras,
Le code que j'utilise:
Sub texteengras()
Dim a As String
a = "Catalogue"
Dim b As String
b = "Allergènes"
c = "Trad. Danois"
Dim i, j As Integer 'i et j= indices pour feuille "Allergènes"
Dim derlig_b As Long
derlig_b = Sheets(b).Range("B65536").End(xlUp).Row

Dim y, z As Integer 'y et z= compteurs pour feuille Trad. Danois
Dim derlig_c As Integer
derlig_c = Sheets(c).Range("E65536").End(xlUp).Row

i = 3
For y = 2 To derlig_c
string_c = Sheets(c).Range("E:E").Cells(y, 1)
allergene = Sheets(b).Range("B:B").Cells(i, 1)
pos = InStr(Sheets(c).Range("E:E").Cells(y, 1), allergene)
longueur = Len(allergene)

While pos > 0
For i = 3 To derlig_b
allergene = Sheets(b).Range("B:B").Cells(i, 1)
pos = InStr(Sheets(c).Range("E:E").Cells(y, 1), allergene)
string_c = Replace(string_c, allergene, Sheets(b).Range("B:B").Cells(i, 1).Font.Bold = True)
Next i
Wend

Next y
End Sub

Je vous remercie de votre aide pour me sortir de l'ornière...
 

Pièces jointes

  • Catalogue.xlsm
    190.8 KB · Affichages: 11

zebanx

XLDnaute Accro
Bonjour ODB

Ce que vous demandez je ne sais pas faire.
Par contre, si vous êtes intéressés pour extraire sur chaque ligne les données retrouvées dans la liste "allergènes" dans une autre colonne, ça c'est possible (ça prend un peu de temps à faire).

Mais il faut que ça vous intéresse sinon...
A vous lire.

Xl-ment
 

ChTi160

XLDnaute Barbatruc
Bonjour ODB
Bonjour le fil (zebanx),le Forum
question:
pourquoi utilises tu cette facon de lister les cellules d une colonne?
ex :
VB:
Sheets(b).Range("B:B").Cells(i, 1)
et non
VB:
Sheets(b).Cells(i, 2)
Merci
jean marie
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Dans le fichier joint la macro 'Grasser' cherchera chaque terme de la première colonne des allergènes dans la colonne E de Trad. Danois et les grassera.

Attention dans Trad. Danois si un des allergènes n'est pas précédé et suivit d'espace (ex: Lait-Oeuf) il ne sera pas trouvé.
donc dans les recettes, séparer les allergènes par des espaces avant et après.

Bonne soirée
 

Pièces jointes

  • Catalogue.xlsm
    206.4 KB · Affichages: 10

zebanx

XLDnaute Accro
Bonjour ODB, ROBLOCHON, le forum

Un essai avec restitution gras et extraction des données.
Tout est repris dans la feuille allerg.

Comme ROBLOCHON :cool: l'a très justement souligné, un point capital reste qu'il faut faire très attention quand on recherche des STRING (textes) à respecter une cassure générant peu de soucis dans l'exécution de la macro.
Les pluriels, les noms avec " " sont des poisons potentiels qui vous obligeront à un contrôle de 2ième niveau long et probablement inutile.

En prenant un seul exemple et sans traiter le cas des upper-case / lower case (aisément contournables):
"Pignons-de-pin" n'est pas :
" Pignons-de-pin " (espace)
"Pignon-de-pin" (manque s)
"Pignon de pin" (s et espace entre les mots)
...

Un moyen de contournement potentiel restant d'étendre la liste de mots-clés aux différents cas rencontrés ou de retravailler préalablement la liste des informations (colonne E pour le francais par exemple) (ie : par un CTRL + H permettant de modifier les différents cas rencontrés).

La macro proposé par ROBLOCHON semble en ce sens mieux répondre à votre attente mais comme vous le voyez en cellule E3 sur "Trad-danois", elle génère sauf erreur / logiquement aussi ce même type de problématique à la restitution sur une base préalable non retraitée (comme il l'a indiqué au #5).

Bonne journée à tous
zebanx
 

Pièces jointes

  • catalogue_allergène.xlsm
    279.9 KB · Affichages: 7

ODB

XLDnaute Nouveau
Bonjour ODB, ROBLOCHON, le forum

Un essai avec restitution gras et extraction des données.
Tout est repris dans la feuille allerg.

Comme ROBLOCHON :cool: l'a très justement souligné, un point capital reste qu'il faut faire très attention quand on recherche des STRING (textes) à respecter une cassure générant peu de soucis dans l'exécution de la macro.
Les pluriels, les noms avec " " sont des poisons potentiels qui vous obligeront à un contrôle de 2ième niveau long et probablement inutile.

En prenant un seul exemple et sans traiter le cas des upper-case / lower case (aisément contournables):
"Pignons-de-pin" n'est pas :
" Pignons-de-pin " (espace)
"Pignon-de-pin" (manque s)
"Pignon de pin" (s et espace entre les mots)
...

Un moyen de contournement potentiel restant d'étendre la liste de mots-clés aux différents cas rencontrés ou de retravailler préalablement la liste des informations (colonne E pour le francais par exemple) (ie : par un CTRL + H permettant de modifier les différents cas rencontrés).

La macro proposé par ROBLOCHON semble en ce sens mieux répondre à votre attente mais comme vous le voyez en cellule E3 sur "Trad-danois", elle génère sauf erreur / logiquement aussi ce même type de problématique à la restitution sur une base préalable non retraitée (comme il l'a indiqué au #5).

Bonne journée à tous
zebanx
 

ODB

XLDnaute Nouveau
Merci pour votre aide et votre réactivité !
Cela dit, j'ai du mal à comprendre la syntaxe bien qu'y ayant passer du temps. J'ai besoin de progresser...A ce propos, auriez vous un contact qui pourrait me proposer quelques heures de formation ?

Merci encore
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Voici la macro largement commentée en espérant que cela vous sera utile à la compréhension.
Il y a un petit changement en fin de boucle Do .... Loop While.
Le test de fin de boucle n'est pas cohérent. Pourtant c'est celui donné par l'aide de Microsoft sur la méthode .Find de l'objet range:
VB:
    '
    ' Exemple Microsoft
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If

C'est incohérent et peut provoquer des erreurs car une variable range (c de l'exemple) ne peut pas être Nothing (rien) et avoir une propriété .Address à comparer à quoique ce soit.

Dans votre cas, cela ne devrait pas intervenir. Si vous ne changez pas les valeurs des cellules trouvées en court de boucle la variable cTrouvee ne devrait jamais être Nothing. Mais par mesure de sécurité, j'ai préféré apporter le petit changement que vous verrez ci-dessous.

Ne vous laissez pas impressionner par la syntaxe, aider vous de l'aide d'excel (F1 sur un mot clef de vba).
Je sais que l'aide est parfois absconse mais si vous avez du mal, revenez ici.
VB:
Sub Grasser()
    ' Plage de cellules qui contient la liste des allergenes à rechercher
    ' Ne pas inclure la cellule d'entête si il y en a une
    Dim allergenes As Range
    ' plage de cellules dans laquelle faire la recherche des allergènes
    ' inclure la cellule d'entête (celle après laquelle commencera la recherche)
    Dim plageRecherche As Range
    '
    Dim cAllergene As Range ' Cellule de boucle for contenant l'allergène en cours de recherche
    Dim cTrouvee As Range   ' Cellule de la plage de recherche qui contient l'allergène trouvé
    '
    Dim adr As String ' Adresse de la première cellule trouvée dans la plage de recherche
    Dim Terme As String ' terme (mot) recherché dans la plage de recherche
    '
    '   Position du mot trouvé dans la cellule et nombre de caractère du mot (Terme)
    Dim pos As Integer, nbCars As Integer
    '
    ' Initialisation de la plage des allergènes
    ' à partir du tableau courant de la cellule B2
    ' ce peut être n'importe quelle cellule contenue dans le tableau.
    ' N'en retenir que la première colonne (celle qui contient les termes à chercher
    ' débarrasser la plage de la cellule d'entête en décalant la plage, d'une ligne
    ' et en la retaillant du nombre de ligne -1
    With Sheets("Allergènes").Range("B2").CurrentRegion.Columns(1)
        Set allergenes = .Offset(1).Resize(.Rows.Count - 1)
    End With
    '
    ' Initialisation de la plage de recherche
    ' Idem que pour la plage des allergènes, sans, cette fois se priver de l'entête.
    ' La méthode .Find de l'objet Range, utilisée plus bas demande une cellule
    ' à partir de laquelle commencer la recherche.
    ' Cette cellule quant à elle n'est jamais explorée par la méthode .Find, c'est pour cela qu'on conserve l'entête.
    Set plageRecherche = Sheets("Trad. Danois").Range("A1").CurrentRegion.Columns(5)
    
    '
    ' Ré-initialiser le grassage des polices de la plage de recherche
    plageRecherche.Font.Bold = False
    
    
    '
    ' Parcours des cellules de la plage des allergènes
    For Each cAllergene In allergenes.Cells
        '
        ' Si la cellule parcourrue n'est pas vide, on lance la recherche
        '
        If Not IsEmpty(cAllergene) Then
            Terme = cAllergene.Text ' Texte de la cellule à chercher
            nbCars = Len(Terme) ' Nombre de caractère du texte
            '
            ' Préfixer le terme d'une espace afin d'éviter que la recherche se fasse à l'intérieur des mots.
            ' exemple qu'il ne trouve pas 'lait' dans 'allaitement' (il trouvera 'lait' de ' laitage'
            Terme = " " & Terme
            '
            ' Lancer la recherche du terme à partir de la première cellule (entête) de la plage de recherche.
            Set cTrouvee = plageRecherche.Find(what:=Terme, After:=plageRecherche.Cells(1, 1), LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
            '
            ' Si la méthode .Find a trouvé quelque chose (retourn la cellule trouvée)
            If Not cTrouvee Is Nothing Then
                '
                ' Retenir la première addresse avant du passer aux  cellules suivantes.
                ' (La méthode .FindNext fait tourner en boucle la recherche à l'intérieur
                ' de la plage.
                adr = cTrouvee.Address
                ' initialisation de la boucle de recherche des cellules correspondantes dans la plage
                Do
                    ' Commencer par traiter la cellule trouvée
                    ' déterminer la position du terme suffixé d'un espace ( pour qu'il ne trouve pas ' lait' de' laitage'
                    pos = InStr(1, cTrouvee, Terme & " ", vbTextCompare)
                    '
                    ' Si le terme est bien là
                    ' Alors grasser à partir de la position du terme +1 (pour ne pas grasser l'espace)
                    ' jusqu'au nombre de caractères de l'allergène trouvé
                    If pos > 0 Then cTrouvee.Characters(pos + 1, nbCars).Font.Bold = True
                    '
                    ' Chercher l'occurence suivante dans la plage de recherche
                    ' à partir de celle qui a déjà été trouvée.
                    Set cTrouvee = plageRecherche.FindNext(cTrouvee)
                    '
                    ' Changement: si .FindNext ne trouve rien, sortir de la boucle
                    If cTrouvee Is Nothing Then Exit Do
                    '
                    ' Continuer tant que .FindNext n'est pas revenu à la première cellule trouvée
                Loop While cTrouvee.Address <> adr
            End If
        End If
    Next
End Sub

Bonne cogitation
 
Dernière édition:

zebanx

XLDnaute Accro
Bonjour à tous les deux

Bravo pour le détail à Roblochon.

En repartant d'un code fournis (jadis) par l'ami Gosselien :cool:, la restitution apparait pertinente en terme de mots retrouvés selon les cas évoqués supra.
Attention toutefois, la recherche ne se fait que sur une seule valeur retrouvée comme le montre la première valeur identifiée.

Mais là pour le coup les "interespace" entre deux mots sont pris en considération contrairement à la méthode développée au 7.
(Pour moi ça reste cependant trop dangereux et je préfère ne pas les avoir dans mon champ de recherche. Donc fromage-blanc vaut mieux que fromage blanc).

xl-ment.
zebanx
 

Pièces jointes

  • autre_methode_gras.xlsm
    135.7 KB · Affichages: 9

ODB

XLDnaute Nouveau
Bonjour Roblochon, et zebanx,
Merci infiniment pour vos réponses commentées et le temps que vous y avez passé. Je vais passer du temps dessus ce matin. Nul doute que ca contribue à me faire progresser et m'approprier progressivement la logique et la syntaxe à adopter,
Bonne journée à Tous deux
 

Discussions similaires

Statistiques des forums

Discussions
312 086
Messages
2 085 197
Membres
102 814
dernier inscrit
JLGalley