SOLVED

Extraction d'un text en gras

Copper 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 (Copper 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
1 best response

Accepted Solutions
best response confirmed by Mounou_Zz (Copper 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

View solution in original post