Sub Macro1()
Dim i As Long, Arr(), LastRow As Long, x As Long, ii As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Arr = Range(Cells(1, 1), Cells(LastRow, 2)).Value
For i = 1 To UBound(Arr)
For ii = 1 To Len(Arr(i, 1))
x = x + CInt(Mid(Arr(i, 1), ii, 1))
Arr(i, 2) = x
Next
x = 0
Next
Range("A1").Resize(UBound(Arr), 2).Value = Arr
End Sub