Option Explicit
Sub LoaiBoSo()
Dim i&, j&, cell As Range, k As String, st As String, arr(1 To 10000, 1 To 3)
Application.ScreenUpdating = False
For Each cell In Selection
st = "": j = 0
For i = 1 To Len(cell)
k = Mid(cell, i, 1)
If Not IsNumeric(k) Then
j = j + 1
arr(j, 1) = k: arr(j, 2) = cell.Characters(i, 1).Font.Color
arr(j, 3) = cell.Characters(i, 1).Font.Bold
End If
Next
For i = 1 To j
st = st & arr(i, 1)
Next
cell.Value = st
For i = 1 To j
With cell.Characters(i, 1).Font
.Color = arr(i, 2)
.Bold = arr(i, 3)
End With
Next
Next
Application.ScreenUpdating = True
End Sub
