XL 2016 Parcourir les chaînes de caractères et mettre en gras si elles contiennent des chiffres

[JN1]

Bonsoir et merci à vous, car grâce à vos échanges sur le forum et à la mise à disposition de vos exemples de codes, les personnes comme moi (qui n’y connaissent rien en vba) arrivent à réaliser des fichiers qui facilitent leur vie professionnelle au quotidien.

Le site de Mr Jacques BOISGONTIER, très riche et très clair est d’une grande aide également, merci à lui.

Je vous sollicite car je bute sur un problème de mise en forme de texte.

A partir de formulaires, ma macro génère un découlé opératoire en remplaçant un texte à trous par des données numériques, alpha-numériques et du texte.

Et mon souhait est de mettre en gras uniquement les données numériques et alpha-numériques.

Le découlé opératoire est très variable en nombres de lignes, en types de données, en caractères utilisé, bref les données à passer en gras ne sont jamais aux mêmes endroits.

En résumé, je souhaite parcourir les chaînes de caractères séparées par un espace dans une seule cellule, identifier s’il s’agit d’une chaîne numérique ou alpha-numériques et si tel est le cas faire une mise en gras.

J’ai fait plusieurs essais dans le fichier exemple joint.

Voici le avant/après que je souhaiterais.

Merci à vous

 

[Staple1600]

Bonsoir

Je mets le gras
Je laisse aux autres le coloriage

Sub Mettre_En_gras()
Dim X&, NbC&, Cell As Range, vArrT() As String
Application.ScreenUpdating = False
For Each Cell In ActiveSheet.UsedRange.SpecialCells(xlConstants)
        vArrT = Split(Cell.Value)
        NbC = 0
            For X = 0 To UBound(vArrT)
            If Not vArrT(X) Like "*[!A-Z]*" Or Not vArrT(X) Like "*[!0-9]*" Then Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
            NbC = NbC + Len(vArrT(X)) + 1
        Next
Next
End Sub

 

[JN1]

Bonjour Staple1600,
Merci beaucoup de ton retour et de ta réactivité.
Voici ce que ça donne chez moi.
A partir de ton code je vais pouvoir appliquer les conditions de mise en forme.

Bonne journée à toi.

 

[JN1]

Staple1600,

J'ai ajouté mes conditions et voici le résultat avec les couleurs.
Merci beaucoup.

Sub Mettre_En_gras()
Dim X&, NbC&, Cell As Range, vArrT() As String
Application.ScreenUpdating = False
For Each Cell In ActiveSheet.UsedRange.SpecialCells(xlConstants)
vArrT = Split(Cell.Value)
NbC = 0
For X = 0 To UBound(vArrT)
If vArrT(X) Like "*BNL*" Or vArrT(X) Like "*[A-Z][A-Z][A-Z][A-Z]*" Then
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.ColorIndex = 5
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
End If
If vArrT(X) Like "*NAS*" Or vArrT(X) Like "*HST*" Or vArrT(X) Like "*ASP*" Or vArrT(X) Like "*HATS*" Then
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.ColorIndex = 10
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
End If
If vArrT(X) Like "*HPT*" Then
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.ColorIndex = 45
Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
End If
If vArrT(X) Like "*[0-9]*" Or vArrT(X) Like "*[0-9*.]*" Then Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
NbC = NbC + Len(vArrT(X)) + 1
Next
Next
End Sub

 

[Staple1600]

Bonsoir

Testes mon code tel que publié dans le message#2 et tu verras que seul les majuscules et les chiffres sont mis en gras.

Const Chaine As String = "abc DEFG 123 fgh 12584"

Sub gen_datas()
Dim i, j
For i = 1 To 11 Step 3
For j = 1 To 11 Step 4
Cells(Application.RandBetween(1, 30), Application.RandBetween(1, 5)) = Chaine
Next j
Next i
ActiveSheet.UsedRange.Columns.AutoFit
End Sub
Sub Mettre_En_gras()
Dim X&, NbC&, Cell As Range, vArrT() As String
Application.ScreenUpdating = False
For Each Cell In ActiveSheet.UsedRange.SpecialCells(xlConstants)
        vArrT = Split(Cell.Value)
        NbC = 0
            For X = 0 To UBound(vArrT)
            If Not vArrT(X) Like "*[!A-Z]*" Or Not vArrT(X) Like "*[!0-9]*" Then Cell.Characters(NbC + 1, Len(vArrT(X))).Font.Bold = -1
            NbC = NbC + Len(vArrT(X)) + 1
        Next
Next
End Sub

Pour faire le test, lance la macro gen_datas sur une feuille vierge puis lance la macro Mettre_En_gras (sans la modifier d'un iota )

 

[JN1]

Bonsoir Staple1600, effectivement c'est parfait.
Merci encore.