Mettre en gras une sous-chaine de caractere dans une chaine de caractère

Y compris Power BI, Power Query et toute autre question en lien avec Excel
O
ODB_VBA
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 17 juin 2019
Version d'Excel : version 16.25 Mac OS

Message par ODB_VBA » 17 juin 2019, 15:24

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...
Catalogue.xlsm
(190.68 Kio) Téléchargé 5 fois
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 17 juin 2019, 17:15

Bonjour,

Avec l' enregistreur de macro je crois qu'excel met en gras la portion de chaîne allant du caractère numéro x au caractère numéro y.
Donc dans votre cas si allergènes il y a il faut trouver ses positions de départ et d'arrivée afin d'y appliquer "le gras"

Mais ça c'est parce que je ne suis pas bon ! Il y a peut être plus simple...

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 17 juin 2019, 17:19

With ActiveCell.Characters(start:=13, length:=4).Font
.FontStyle = "Gras" 
End Whith
Ici on met en gras du caractère 13 au caractère 16, car du caractère 13 compris avec une longueur de 4 ça fait 16.

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 17 juin 2019, 17:23

Reste plus qu'à trouver la position de départ de l'allergene car sa longueur vous la connaissez puisque vous le cherchez.. ;;)

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
O
ODB_VBA
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 17 juin 2019
Version d'Excel : version 16.25 Mac OS

Message par ODB_VBA » 17 juin 2019, 22:09

Merci beaucoup pour votre réponse, je regarde ça...
Est ce que cette procédure fonctionne si l’allergene Est présent plusieurs fois dans la chaîne de caractère ?
Merci
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 17 juin 2019, 22:18

Attention ! la procédure ne trouve pas le mot ! ;-)
Il faut trouver la position des mots dans la chaine et une fois la position trouvée appliquer la mise en forme.

Cette procédure de recherche serait à effectuer tant qu'il "reste" des caractères à la chaine, du coup test après test il sera possible de mettre en gras plusieurs fois le même allergène.

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 18 juin 2019, 20:24

Bonsoir,

ci dessous un code qui scanne les allergènes un par un et qui met en gras et en rouge l'allergène trouvé :
Sub Gras_et_Rouge()
    Dim Position As Integer ' position du premier caractère de l'allergène trouvé
    Dim NO_Caractère As Integer ' numéro du caractère de départ pour la recherche
    Dim Chaine As String ' variable contenant la chaine à transformer
    Dim Allergène() ' tableau des allergènes à chercher
    Dim Bcl As Integer ' variable pour boucler sur le tableau des allergènes
    
    Chaine = Range("A1").Value
    Allergène() = Array("Sucre", "Blé", "Gluten", "Sel", "Oeufs")
    NO_Caractère = 1
    ' on boucle le tableau des allergène de 0 à l'indice supérieur du tableau
    For Bcl = 0 To UBound(Allergène)
        ' boucle "indéfinie" sur la chaine testée
        Do
            ' on cherche le numéro de caractère dans la chaine où l'allergène "commence"
            ' ce test se fait avec les mots en "majuscule", comme cela il y a la même casse
            Position = InStr(NO_Caractère, UCase(Chaine), UCase(Allergène(Bcl)))
            ' si on trouve une position = allergène trouvé, on met en rouge et en gras
            ' à partir du premier caractère trouvé de l'allergène sur une longueur égale à la longueur de l'allergène
            If Position > 0 Then
                Range("A1").Characters(Start:=Position, Length:=Len(Allergène(Bcl))).Font.Bold = True
                Range("A1").Characters(Start:=Position, Length:=Len(Allergène(Bcl))).Font.Color = RGB(255, 0, 0)
                ' la prochaine recherche se fait à partir du caractère suivant le dernier de l'allergène
                NO_Caractère = Position + Len(Allergène(Bcl))
            Else
                ' si pas de retour c'est qu'il n'y a plus l'allergène recherché dans la chaine, on sort de la boucle
                Exit Do
            End If
        Loop
        ' on recommence au début de la chaine pour l'allergène suivant
        NO_Caractère = 1
    Next Bcl
    ' le tableau des allergènes a été scanné, la procédure est finie
End Sub
Evidemment le code ici "n'est pas fini" car il ne teste que la cellule A1 ! ;-)
Mais le principe est là !

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 24 juin 2019, 21:06

Bonsoir,

le principe est là mais la réponse est absente... :oops:

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Avatar du membre
MaPoire
Membre fidèle
Membre fidèle
Messages : 200
Appréciations reçues : 9
Inscrit le : 17 septembre 2011
Version d'Excel : 2010

Message par MaPoire » 24 juin 2019, 23:31

Bonsoir à tous,

Du recyclage de fichier :P . Un essai dans le fichier joint. Le bouton "Hop!" est associé à la macro TEST (modulel1):
Sub test()
  Chercher_Colorier_plage_liste Sheet2.Range("e2:e400"), Sheet5.Range("b3:b18")
  MsgBox "C'est terminé."
End Sub
Chercher_Colorier_plage_liste est une procédure avec deux arguments en entrée :
  • le premier argument (xrgTxt) est la plage où rechercher les valeurs à mettre en forme (la plage peut être réduite à une seule cellule)
  • le second argument (xrgQuoi) est la plage des textes à rechercher (la plage peut être réduite à une seule cellule)
  • la procédure colore les textes trouvés en appliquant la mise en forme des textes à rechercher (caractère par caractère). Par mise en forme, on entend la graisse et la couleur
  • le code de la procédure (et des procédures appelées) sont dans module1
ODB_VBA- Catalogue- v1.xlsm
(212.11 Kio) Téléchargé 8 fois
Avatar du membre
LouReeD
Contributeur
Contributeur
Messages : 5'841
Appréciations reçues : 240
Inscrit le : 14 octobre 2014
Version d'Excel : 2013 FR, 2016 FR
Contact :
Téléchargements : Mes applications

Message par LouReeD » 25 juin 2019, 19:05

Bonsoir,

du recyclage mais toujours pas de retour...
Mais pourquoi caractère par caractère vu que vous connaissez le mot et sa longueur ?

@ bientôt

LouReeD
Contributeur depuis peu ! 8-)
Quelques règles à lire ICI ;;)
______________________________________________________Vous pouvez allez faire un tour sur : Index de "Mes applications" ;;)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message