SOLVED

Extraction d'un text en gras

%3CLINGO-SUB%20id%3D%22lingo-sub-2398404%22%20slang%3D%22fr-FR%22%3EExtracting%20a%20bold%20text%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2398404%22%20slang%3D%22fr-FR%22%3E%3CP%3EHello%2C%20I%20have%20thousands%20of%20line%20in%20this%20model%3A%3C%2FP%3E%3CTABLE%20width%3D%22311%22%3E%3CTBODY%3E%3CTR%3E%3CTD%20width%3D%22310px%22%20height%3D%2230px%22%3ETotal%20Over%202.5%3CSTRONG%3E1%2C124%3C%2FSTRONG%3E%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%22310px%22%20height%3D%2230px%22%3ETotal%20Less%20than%202.5%3CSTRONG%3E5.05%3C%2FSTRONG%3E%3C%2FTD%3E%3C%2FTR%3E%3CTR%3E%3CTD%20width%3D%22310px%22%20height%3D%2230px%22%3ETotal%20Over%3CSTRONG%3E3%2C1.16%3C%2FSTRONG%3E%3C%2FTD%3E%3C%2FTR%3E%3C%2FTBODY%3E%3C%2FTABLE%3E%3CP%3EI%20want%20to%20cut%20the%20part%20in%20Fat%20format%20and%20copy%20it%20in%20the%20column%20next%2C%20like%3A%3C%2FP%3E%3CP%3ETotal%20Over%202.5%20and%20%3CSTRONG%3E1%2C124%3C%2FSTRONG%3E%3C%2FP%3E%3CP%3E%3CSTRONG%3EThanks%20for%20the%20help.%26nbsp%3B%3C%2FSTRONG%3E%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2398404%22%20slang%3D%22fr-FR%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2398483%22%20slang%3D%22fr-FR%22%3ERe%3A%20Extracting%20a%20bold%20text%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2398483%22%20slang%3D%22fr-FR%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1066610%22%20target%3D%22_blank%22%3E%40Mounou_Zz%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EThis%20is%20a%20macro.%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3ESub%20SplitBold()%0A%20%20%20%20'%20Changez%20si%20n%C3%A9cessaire%0A%20%20%20%20Const%20Col%20%3D%20%22A%22%20%20%20%20'%20colonne%0A%20%20%20%20Const%20FirstRow%20%3D%201%20'%20premi%C3%A8re%20ligne%0A%20%20%20%20Dim%20i%20As%20Long%0A%0A%20%20%20%20Dim%20LastRow%20As%20Long%0A%20%20%20%20Dim%20r%20As%20Long%0A%0A%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%0A%20%20%20%20Range(Col%20%26amp%3B%201).Offset(0%2C%201).EntireColumn.Insert%0A%20%20%20%20LastRow%20%3D%20Range(Col%20%26amp%3B%20Rows.Count).End(xlUp).Row%0A%20%20%20%20For%20r%20%3D%20FirstRow%20To%20LastRow%0A%20%20%20%20%20%20%20%20If%20Range(Col%20%26amp%3B%20r).Value%20%26lt%3B%26gt%3B%20%22%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20Do%20While%20Range(Col%20%26amp%3B%20r).Characters(i%20%2B%201%2C%201).Font.Bold%20%3D%20False%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20i%20%3D%20i%20%2B%201%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20If%20i%20%3D%20Len(Range(Col%20%26amp%3B%20r).Value)%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Exit%20Do%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20%20%20%20%20Loop%0A%20%20%20%20%20%20%20%20%20%20%20%20Range(Col%20%26amp%3B%20r).Offset(0%2C%201).Value%20%3D%20Mid(Range(Col%20%26amp%3B%20r).Value%2C%20i%20%2B%201)%0A%20%20%20%20%20%20%20%20%20%20%20%20Range(Col%20%26amp%3B%20r).Value%20%3D%20Left(Range(Col%20%26amp%3B%20r).Value%2C%20i)%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20Next%20r%0A%0A%20%20%20%20Application.ScreenUpdating%20%3D%20True%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2398500%22%20slang%3D%22fr-FR%22%3ERe%3A%20Extracting%20a%20bold%20text%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2398500%22%20slang%3D%22fr-FR%22%3EThanks%20%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F21903%22%20target%3D%22_blank%22%3E%40hans%3C%2FA%3E%20Vogelarr%3C%2FLINGO-BODY%3E
New Contributor

Bonjour , j'ai des milliers de ligne dans ce model :

Total Plus de 2.51.124
Total Moins de 2.55.05
Total Plus de 31.16

Je souhaite couper la partie en format Gras et le copier dans la colonne à coté ,genre : 

Total Plus de 2.5   et  1.124

Merci pour l'aide . 

2 Replies
best response confirmed by Mounou_Zz (New Contributor)
Solution

@Mounou_Zz 

 

Ici un macro.

Sub SplitBold()
    ' Changez si nécessaire
    Const Col = "A"    ' colonne
    Const FirstRow = 1 ' première ligne
    Dim i As Long

    Dim LastRow As Long
    Dim r As Long

    Application.ScreenUpdating = False

    Range(Col & 1).Offset(0, 1).EntireColumn.Insert
    LastRow = Range(Col & Rows.Count).End(xlUp).Row
    For r = FirstRow To LastRow
        If Range(Col & r).Value <> "" Then
            i = 0
            Do While Range(Col & r).Characters(i + 1, 1).Font.Bold = False
                i = i + 1
                If i = Len(Range(Col & r).Value) Then
                    Exit Do
                End If
            Loop
            Range(Col & r).Offset(0, 1).Value = Mid(Range(Col & r).Value, i + 1)
            Range(Col & r).Value = Left(Range(Col & r).Value, i)
        End If
    Next r

    Application.ScreenUpdating = True
End Sub
Merci @hans Vogelarr