Страницы: 1
RSS
Сумма цифр числа
 
Есть число, например:  
54901    
Нужна формула, которая считает сумму цифр его соствляющих, т.е.: 5+4+9+0+1=19, а затем сумму цифр получившейся суммы, т.е.: 1+9=10 и так далее: 1+0=1, до тех пор, пока после знака "равно" не получится однозначное число.  
Заранее спасибо.
 
Private Function Summa_Znach(x As String)  
 Dim i As Integer  
 Dim j As Integer  
 Dim tSum As Variant  
 If Len(x) > 1 Then  
   tSum = x  
   Do While Len(tSum) > 1  
     tSum = 0  
     For i = 1 To Len(x)  
       tSum = tSum + Val(Mid(x, i, 1))  
     Next i  
     If Len(tSum) > 1 Then  
       x = tSum  
     End If  
   Loop  
   Summa_Znach = tSum  
 Else  
   Summa_Znach = Val(x)  
 End If  
End Function
 
Да формулой одной не обойтись, так, что без VBA никуда...
 
ну почему же, а если вот так  
=ЗНАЧЕН(ЛЕВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(A1;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;2);2;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;3);3;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;4);4;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;5);5;1));1))+ЗНАЧЕН(ПРАВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(A1;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;2);2;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;3);3;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;4);4;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;5);5;1));1));1))+ЗНАЧЕН(ПРАВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(A1;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;2);2;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;3);3;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;4);4;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;5);5;1));1))+ЗНАЧЕН(ПРАВСИМВ(ЗНАЧЕН(ЛЕВСИМВ(A1;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;2);2;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;3);3;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;4);4;1))+ЗНАЧЕН(ПСТР(ЛЕВСИМВ(A1;5);5;1));1));1))
 
Вот ещё VBA-вариант - с рекурсией:  
==  
' Sum of Digits  
Function SDig(srcString As String) As Integer  
Dim i As Integer  
   SDig = 0  
   For i = 1 To Len(srcString)  
       SDig = SDig + Val(Mid(srcString, i, 1))  
   Next  
   If Len(CStr(SDig)) > 1 Then SDig = SDig(CStr(SDig))  
End Function  
==
 
Артем, формула не рабочая !  
С числом 54901 она справилась ХОРОШО !  
НО !  
Стоит подставить к примеру 25896, то она выдает ответ 6, хотя калькуляторным методом я получаю 3 !!!  
 
И большой минус в том, что ограничено как минимальное количество цифр, иак и максимальное, а раздувать формулу еще  - это моразм.  
 
Так, что VBA сдесь РУЛИТ !
 
Спасибо большое.
 
Перемудрили вы, ребята.  
Искомое число циклически меняется от 1 до 9 и равно остатку от деления числа на девять, за исключением случаев, когда число кратно 9.  
Формула достаточно проста:  
=ЕСЛИ(ОСТАТ(A1;9)=0;9;ОСТАТ(A1;9))
 
Да, действительно всё просто оказалось. Позор-то какой! :)))  
 
Кстати, формулу можно немного упростить:  
=ОСТАТ(A1-1;9)+1  
А если ещё приделать проверку на 0, то:  
=ЕСЛИ(A1<=0;0;ОСТАТ(A1-1;9)+1)  
или, по-хулигански:  
=(A1>0)*(ОСТАТ(A1-1;9)+1)  
 
Кстати, на этом свойстве (что если из числа вычесть сумму его цифр, то оно будет делиться на 9) основан известный интернет-прикол с магическим квадратом:  
http://angel2004.biz/mk.htm
 
Да уж, хорошо что предупредили, а то у неподготовленного челове крыша съехать ожет. Вот же паразиты с http://angel2004.biz/mk.htm. :-)
 
Под впечатлением всей этой нумерологии забацал эксель прикол. Зацените.
 
Работает, но не сходится (где-то не там значки расставляются). Плюс спеллчекером бы неплохо пройтись :)
 
Что за ерунда, действительно врет. У меня всё отлично работает - а ничего не менял. Странно...  
Спелчекера не надо - это оригинальный дизайнерский замысел :-)
 
Как быть если конечное число должно быть в диапазон от 1 до 12 включительно?  
 
По формуле    
=ЕСЛИ(ОСТАТ(A1;9)=0;9;ОСТАТ(A1;9))  
 
из 29 получим 2, а нужно 11. Как видоизменить формулу, пробовал сам, что-то не так выходит.
 
Здравствуйте! Нравятся такие задачки, код можно еще так записать:  
Function SumNums_2(stroka As String)  
Dim b&, i&  
If Len(stroka) <= 1 Then SumNums_2 = stroka: Exit Function  
While Len(stroka) > 1  
For i = 1 To Len(stroka)  
b = Val(b) + Val(Mid(stroka, i, 1))  
Next i  
stroka = b: b = 0  
Wend  
SumNums_2 = stroka  
End Function
 
вариант  
чтоб формула не была громоздкой  
создадим имя "формула" с формулой  
СУММ(ЕСЛИ(ЕОШИБКА(--ПСТР(A1;СТРОКА(1:10);1));0;(--ПСТР(A1;СТРОКА(1:10);1))))  
тогда в ячейке  
=ЕСЛИ(формула<=12;формула;СУММ(ЕСЛИ(ЕОШИБКА(--ПСТР(формула;СТРОКА(1:5);1));0;(--ПСТР(формула;СТРОКА(1:5);1)))))  
 
в первой формуле СТРОКА(1:10) это максимальное количество цифр в числе которое будет считаться. если нужно максимум пятизначное число то меняем на СТРОКА(1:5)и СТРОКА(1:5)меняем на СТРОКА(1:2)
 
забыл указать в ячейке формула вводится как формула массива.
 
Public Function SumDigits&(n&)  
   Dim s$, a  
   While Len(CStr(n)) > 1  
       s = Replace(String(Len(CStr(n)), "@"), "@", "@ ")  
       n = Evaluate(Join(Split(Format(n, Mid$(s, 1, Len(CStr(n)) * 2 - 1))), "+"))  
   Wend  
   SumDigits& = n  
End Function
Я сам - дурнее всякого примера! ...
 
Серж, это круто!!!  
Однако, можно без join(split:  
 
Public Function SumDigits&(ByVal n&)  
While Len(CStr(n)) > 1  
n = Evaluate(Format(n, Replace(Space(Len(CStr(n))), " ", "@+") & 0))  
Wend  
SumDigits = n  
End Function
 
Отлично, Леш!
Я сам - дурнее всякого примера! ...
 
Evaluate это конечно красиво, но очень медленно, особенно в сочетании с текстовыми функциями и преобразованием типов  
 
например целочисленная арифметика работает в десятки раз быстрее (у меня получилос в 32 раза):  
 
Function SumDig&(ByVal n&)  
   While n > 0  
       SumDig = SumDig + n Mod 10  
       n = n \ 10  
   Wend  
   If SumDig > 9 Then SumDig = SumDig(SumDig)  
End Function
Страницы: 1
Наверх