Abreger Nombre !

Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim C As Integer 'déclare la variable C (Centaines)
Dim D As Byte 'déclare la variable D (Dizaines)
Dim U As Byte 'déclare la variable U (Unités)

Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet O
Set PL = Range("A1:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle sur toutes les cellules CEl de la plage PL
    If CEL <> "" Then 'condition : si la cellule n'est pas vide
        C = CInt(Mid(CEL.Value, 1, 1)) + CInt(Mid(CEL.Value, 2, 1)) 'définit la variable C
        If C > 9 Then C = CInt(Mid(C, 1, 1)) + CInt(Mid(C, 2, 1)) 'si C est supérieure à 9, redéfinit la variable C
        D = CByte(Mid(CEL.Value, 3, 1)) + CByte(Mid(CEL.Value, 4, 1)) 'définit la variable D
        If D > 9 Then D = CInt(Mid(D, 1, 1)) + CInt(Mid(D, 2, 1)) 'si D est supérieure à 9, redéfinit la variable D
        U = CByte(Mid(CEL.Value, 5, 1)) + CByte(Mid(CEL.Value, 6, 1)) 'définit la variable U
        If U > 9 Then U = CInt(Mid(U, 1, 1)) + CInt(Mid(U, 2, 1)) 'si U est supérieure à 9, redéfinit la variable U
        CEL.Offset(0, 1).Value = 100 * C + 10 * D + U 'place dans la cellule adjacente à CEL la valeur obtenue
    End If 'fin de la condition
Next CEL 'prochaine cellule de la boucle
End Sub

Public Function DecToBase(dTarget As Double, Optional ByVal iBaseOut As Integer) As String
 Const sBASE As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 Dim sOut As String
 Dim dRemainder As Double
 '--------------
 If (iBaseOut < 2) Or (iBaseOut > 36) Then DecToBase = "Base " & iBaseOut & " !! out of range(2-36)": GoTo exit_f
 '--------------
 sOut = ""
 dTarget = Abs(dTarget)
 '--------------
 Do
    dRemainder = dTarget - (iBaseOut * Int((dTarget / iBaseOut)))
    sOut = Mid$(sBASE, dRemainder + 1, 1) & sOut
    dTarget = Int(dTarget / iBaseOut)
 Loop While (dTarget > 0)
 DecToBase = sOut
 '--------------
exit_f:
 End Function
 '***************************************************************************
 Function BaseToDec(sTarget As String, Optional ByVal iBaseIn As Integer) As String
 Const sBASE As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 Dim dDec As Double
 Dim n As Integer
 If (iBaseIn < 2) Or (iBaseIn > 36) Then BaseToDec = "Base " & iBaseIn & " !! out of range(2-36)": GoTo exit_f
 sTarget = UCase(sTarget)
 '-------------
 n = 0
 '-------------
 Do
 If InStr(sBASE, Mid(sTarget, (Len(sTarget) - n), 1)) > iBaseIn Then BaseToDec = Error(13): Exit Function
    dDec = ((InStr(1, Left(sBASE, iBaseIn), Mid(sTarget, (Len(sTarget) - n), 1)) - 1) * (iBaseIn ^ n)) + dDec
    n = n + 1
 Loop Until n = Len(sTarget)
 BaseToDec = CStr(dDec)
 '-------------
exit_f:
 End Function

Private X As Integer

Sub test()
Dim Rng As Range, T As Variant,i&

With Sheets("Feuil1")
Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3))
End With

T = Rng

For i = LBound(T, 1) To UBound(T, 1)
T(i, 1) = Concat(T(i, 1))
Next i

Rng.Offset(, 1) = T
End Sub

Private Function Concat(ByVal Nb As String) As Integer
Dim i&, Tot&

For i = 1 To Len(CStr(Nb))
Tot = Tot + CInt(Mid(Nb, i, 1))
Next i

If Tot > 9 Then
Concat (Tot)
Else
X = Tot
End If

Concat = X
End Function

Private Function Concat(ByVal Nb As String) As Integer
Dim i&, Tot&
  For i = 1 To Len(Nb): Tot = Tot + Mid(Nb, i, 1): Next i
  If Tot > 9 Then Concat = Concat(Tot) Else Concat = Tot
End Function