[COLOR="DarkSlateGray"][B]Sub mise_en_forme()
Dim tt, ttt, d_l&, j&, k&
Dim M$, r As Range, rr As Range, oDat
Dim Debut As Currency, Fin As Currency, Freq As Currency
QueryPerformanceCounter Debut
Application.ScreenUpdating = False
tt = Array(1, 3, 6, 8, 10)
ttt = Array(30, 45, 23, 12, 12)
With Feuil1
d_l = .Cells(65536, "B").End(xlUp).Row
Set rr = .Range(.Cells(1, "B"), .Cells(d_l, "B"))
Worksheets.Add before:=Sheets(1)
With ActiveSheet
rr.Copy Destination:=.Cells(1, 1)
.Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell)).TextToColumns _
Destination:=.Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False, TrailingMinusNumbers:=True
oDat = .Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell)).Value
Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
End With
.Activate
For j = 1 To d_l
Set r = rr.Item(j)
For k = 0 To UBound(tt)
M = oDat(j, tt(k))
With r.Characters(InStr(1, r.Text, M), Len(M)).Font
.ColorIndex = ttt(k)
.Bold = True
.Underline = True
End With
Next k
Next j
End With
QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
[A13] = Format(((Fin - Debut) / Freq), "0.00") & " s"
Application.ScreenUpdating = True
End Sub[/B][/COLOR]