Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleurs

[dionys0s]

Bonjour tout le monde

j'ai pas mal cherché sur le net avant de poser cette question, et n'ai trouvé qu'un lien pertinent, mais j'ai beau me creuser l'entendement, ça ne marche pas (lien vers la page en question).

Du coup je vous ai mis un petit fichier exemple très clair (en principe).
Dans certaines cellules d'une colonne (pas toutes) le prénom et le nom sont agrégés et le nom est en gras. Je souhaiterait les séparer et les placer dans les deux colonnes adjacentes.

D'avance merci pour votre aide toujours précieuse

dionys0s

 

[R@chid]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Salut @ tous,
essayer en B2 avec :

=STXT(" "&$A1&" ";TROUVE("*";SUBSTITUE(" "&$A1&" ";" ";"*";COLONNES($B:B)))+1;TROUVE("+";SUBSTITUE(" "&$A1&" ";" ";"+";COLONNES($B:C)))-1)

@ tirer vers la droite et puis vers le Bas
Amicalement

 

[dionys0s]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Je n'ai pas l'impression que ça fonctionne.

Je me suis peut-être mal exprimé. Je modifie la pièce jointe.
Je ne veux pas que les noms et prénoms se mettent sur toute la colonne, mais seulement quand ça a lieu d'être.
En principe je voulais que ça se fasse en VBA et non à l'aide d'une fonction en dur, mais je suis preneur de toutes les propositions ^^

Merci en tout cas

 

[dionys0s]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Re le forum

J'ai mis au point une solution en VBA en utilisant ce que j'ai trouvé sur internet :

Dim DerLign As Integer
Dim I As Integer
Dim Pos As Byte
Dim Prenom As String
Dim Nom As String

DerLign = Range("A1000").End(xlUp).Row

For I = 1 To DerLign
    For Pos = 1 To Len(Cells(I, 1).Text)
        If Cells(I, 1).Characters(Pos, 1).Font.Bold Then
            Prenom = Trim(Left(Cells(I, 1), Pos - 1))
            Nom = Trim(Right(Cells(I, 1), Len(Cells(I, 1)) - Pos + 1))
            Cells(I, 2) = Nom
            Cells(I, 1) = Prenom
            GoTo Suite
        End If
    Next Pos
Suite:
Next I

Ça fonctionne, mais vos avis/critiques sont les bienvenues.

dionys0s

 

[BOISGONTIER]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Bonjour,

Voir PJ

Function extraitGras(c)
   Application.Volatile
   For i = 1 To Len(c)
       If c.Characters(Start:=i, Length:=1).Font.Bold = True Then
         temp = temp & Mid(c, i, 1)
       End If
    Next i
    extraitGras = temp
End Function

Function extraitNonGras(c)
   Application.Volatile
   For i = 1 To Len(c)
       If c.Characters(Start:=i, Length:=1).Font.Bold = False Then
         temp = temp & Mid(c, i, 1)
       End If
    Next i
    extraitNonGras = temp
End Function

JB

 

[dionys0s]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Merci beaucoup Boisgontier.

Ceci dit je ne comprends pas tout. Pourrais-tu m'expliquer la démarche please ?

Merci beaucoup

dionys0s

 

[david84]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Bonsoir,
une sub à tester :

Sub test()
Dim DerLig&, i As Byte, j As Byte
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To DerLig Step 8
    For j = 1 To Len(Cells(i, 1))
        If Cells(i, 1).Characters(Start:=j, Length:=1).Font.Bold = True Then
            Cells(i, 1).Offset(, 1) = Left(Cells(i, 1), j - 1)
            Cells(i, 1).Offset(, 2) = Right(Cells(i, 1), Len(Cells(i, 1)) - j + 1)
            Exit For
        End If
    Next j
Next i
End Sub

A+

 

[BOISGONTIER]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Voir PJ

JB

 

[dionys0s]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Re,

j'ai du mal à me faire comprendre ce soir...
Boisgontier j'avais réussi à comprendre comment la faire marcher, mais je voulais juste des éclaircissements sur le code. Mais à part le "Application.Volatile" il me semble que c'est intégré.

merci beaucoup en tout cas.
David merci pour ta proposition. Elle ressemble beaucoup à la mienne avec moins de variables utilisées.
(j'avais jamais pensé au "Rows.Count" tel que tu l'utilises. Brillant ^^)

 

[harpo]

Re : Détecter les caractères en gras d'une cellule, les retirer et les mettre ailleu

Bonjour à tous,
(oui je sais ce post est peu un vieux, mais bon)
En tous cas il à l'air de bien m'aider dans ma quête.
Un petit dessin vaut mieux etc...

je ne sais pas si c'est bon pour l'insertion?
Bon on verra.
En tous cas merci, ça a l'air de fonctionner pour mes stats en paris sportifs 1N2.
Cordialement