.Characters(Start:=3, Length:=1).Font.Superscript = True

Option Explicit

Function СИМВОЛ_РАСШ(i As Integer, bSub As Boolean) As String
     Dim sI As String
     sI = CStr(i)

     Dim j As Byte, sTemp As String, sCh As String * 1, byt As Byte
     sTemp = ""
     For j = 1 To Len(sI)
         sCh = Mid(sI, j, 1)
         byt = CByte(sCh)
         sTemp = sTemp & IIf(bSub, _
                             getSubSymbol(byt), _
                             getSuperSymbol(byt))
     Next j
     СИМВОЛ_РАСШ = sTemp
End Function

Private Function getSubSymbol(i As Byte) As String
     getSubSymbol = ChrW(i + 8320)
End Function

Private Function getSuperSymbol(i As Byte) As String
     Dim iW As Integer
     Select Case i
         Case 1: iW = 185
         Case 2, 3: iW = i + 176
         Case 0, Is > 3: iW = i + 8304
     End Select
     getSuperSymbol = ChrW(iW)
End Function

Sub FORMAT_mm2()
      With ActiveWindow.RangeSelection: .NumberFormat = "#,##0"" мм""" & ChrW(178): .Select: End With
End Sub