нахождение чисел Армстронга

[kabum13]

Задача: Натуральное число из N цифр является числом Армстронга, если сумма его цифр, взведенных в N-ю степень, равна самому числу (как, например, 153 = 1^3 + 5^3 + 3^3). Получить все числа Армстронга, состоящие из двух, трех и четырех цифр.
Преподавателю нужно чтоб в задаче присутствовала работа только с числами, то есть, чтобы она работала без таких функций как Len, Left, Right и т.д. Только совершенно не зню как это число армстронга правильно сформулировать в коде.

Есть вот такой вариант, но он не работает

Private Sub CommandButton1_Click()
Dim q, L, S, N, k, a As Integer
q = 0
k = 0
While N > 0
N = N \ 10
k = k + 1
Wend
While N > 0
a = N Mod 10
S = S + a ^ k
N = N \ 10
Wend
If N = S Then
Cells(q, 1) = S
q = q + 1
End If
End Sub

Исправьте пожалуйста что не так, или предложите более правильный вариант кода, пожалуйста

[EducatedFool]

Sub ОсновнойМакрос()
    For i = 10 To 9999
        If ArmstrongNumber(i) Then Debug.Print i
    Next
End Sub

Function ArmstrongNumber(ByVal Число As Long) As Boolean
    For Степень = 1 To 15
        Сумма = 0
        For j = 1 To 1 + Log(Число) / Log(10)
            Цифра = (Число - (10 ^ j) * (Число \ (10 ^ j))) \ 10 ^ (j - 1)
            Сумма = Сумма + Цифра ^ Степень
        Next j
        If Сумма = Число Then ArmstrongNumber = True: Exit Function
    Next Степень
End Function

Результат:

153
370
371
407
1634
4150
4151
8208
9474

[IgorGO]

или так, кода чуть побольше, но алгоритм намного быстрее

Function ArmDig(dg As Long) As Integer
  Dim dt(10) As Long
  d = dg
  m = 0
  ArmDig = -1
  For i = Int(Log(dg) / Log(10)) To 0 Step -1
    If d >= 10 ^ i Then dt(i) = d \ 10 ^ i: d = d - dt(i) * 10 ^ i Else dt(i) = 0
    If dt(i) > m Then m = dt(i)
  Next
  sd = 0
  If m = 1 Then
    If dg = 1 Then ArmDig = 0
    Exit Function
  End If
  For s = Int(Log(dg) / Log(m)) To 0 Step -1
    For i = 0 To Int(Log(dg) / Log(10)): sd = sd + dt(i) ^ s: Next
    If sd = dg Then ArmDig = s: Exit Function
    If sd < dg Then Exit Function
  Next
End Function


Sub Arm()
  Dim i As Long
  tm = Timer
  For i = 10 To 99999
    r = ArmDig(i)
    If r >= 0 Then Debug.Print i, r
  Next
  Debug.Print Timer - tm
End Sub

на моей системе для чисел от 2 до 5 знаков результат получен за 2.03 секунд.
не оптимизированный алгоритм, предложенный Игорем, выдал тот же результат за 14.95 секунд.

[MCH]

По моему число Армстронга считается несколько по другому:
"...число Армстронга — натуральное число, которое в данной системе счисления равно сумме своих цифр, возведённых в степень, равную количеству его цифр." - Википедия
и соответственно достаточно быстрый код:

Sub ОсновнойМакрос()
    For i = 10 To 99999
        If ArmstrongNumber(i) Then Debug.Print i
    Next
End Sub

Function ArmstrongNumber(ByVal Число As Long) As Boolean
    Степень = Int(Log(Число) / Log(10)) + 1
    Сумма = 0
    Число2 = Число
    For j = 1 To Степень
        Цифра = Число2 Mod 10
        Сумма = Сумма + Цифра ^ Степень
        If Сумма > Число Then Exit Function
        Число2 = Число2 \ 10
    Next j
    If Сумма = Число Then ArmstrongNumber = True
End Function

Результат:

153
370
371
407
1634
8208
9474
54748
92727
93084

[IgorGO]

кстати, да. степень должна соответствовать количеству цифр в числе.
153 3
370 3
371 3
407 3
1634 4
4150 5
4151 5
8208 4
9474 4
54748 5
92727 5
93084 5
красные не числа Армстронга. не то мы с Игорем считали... я еще степени показывал в результатах... очередная штанга. когда в школе проходили числа Армстронга, я, видимо, прогулял урок.

[MCH]

А можно и формулками порешать, тоже достаточно быстро считает от 10 до 99999 (правда только в 2007/2010):

=НАИМЕНЬШИЙ(ЕСЛИ(МУМНОЖ(ОСТАТ(ОТБР(СТРОКА($10:$99999)/{1;10;100;1000;10000});10)^ОТБР(LOG(СТРОКА($10:$99999))+1);{1:1:1:1:1})=СТРОКА($10:$99999);СТРОКА($10:$99999));СТРОКА())