I want to get cross sum of numbers rounding to one digit.
For example 789 = 24 but I want to get 6 from the first time.
Sub quersumme()
Dim a As Integer
Dim ln As Integer
Dim mystring As Integer
On Error Resume Next
mystring = Cells(1, 1).Value
a = 0
ln = Len(mystring)
For i = 1 To ln
a = a + Mid(mystring, i, 1)
Next i
Cells(1, 2) = a
End Sub
I guess you want to keep calculating the cross sum ("quersumme" ) as long as it is greater equal ten.
My suggestion would be
Option Explicit
Sub Quersumme_OneDigit()
Dim res As Long
res = Cells(1, 1).Value
Do
res = Quersumme(res)
Loop Until res < 10
Cells(1, 2) = res
End Sub
Function Quersumme(ByVal Zahl As Double) As Double
Dim i As Long
Dim Summe As Double
For i = 1 To Len(CStr(Zahl))
Summe = Summe + Mid(CStr(Zahl), i, 1)
Next
Quersumme = Summe
End Function