Function Get_Small_Char(rCell As Range)
    Dim li As Long, sTxt As String
    Dim dblSize As Double, dblMin As Double, lMinPos As Long
    dblMin = rCell.Characters(1, 1).Font.Size
    For li = 2 To Len(rCell.Value)
        dblSize = rCell.Characters(li, 1).Font.Size
        If (dblSize < dblMin) Then
            dblMin = dblSize
            lMinPos = li
        End If
    Next li
    Get_Small_Char = rCell.Characters(lMinPos, 1).Text
End F unction