Per velocizzare con i numeri di caratteri che formano una cifra si dovrebbe usare il CASE(), oppure secondo me sarebbero meglio creare macro che eseguono solo determinati range di numeri ex:
da 0 a 9
da 10 a 99
da 100 a 999
da 1000 a 9999
da 10000 a 99999
ecc ecc ecc

Option Explicit
Sub Narcisi()
Dim X As Long, Iniz As Long, Fine As Long, tot As Long, Msg As String
Iniz = InputBox("Inserisci un numero di partenza", 0)
If Iniz < 0 Then MsgBox "Numero errato": Exit Sub
Fine = InputBox("Inserisci il numero finale", 0)
If Fine < 0 Then MsgBox "Numero errato": Exit Sub
    For X = Iniz To Fine
        tot = Len(CStr(X))
        Select Case tot
            Case "1"
                If Mid(X, 1, 1) ^ tot = X Then Msg = Msg & X & "_ "
            Case "2"
                If Mid(X, 1, 1) ^ tot + Mid(X, 2, 1) ^ tot = X Then Msg = Msg & X & "_ "
            Case "3"
                If Mid(X, 1, 1) ^ tot + Mid(X, 2, 1) ^ tot + Mid(X, 3, 1) ^ tot = X Then Msg = Msg & X & "_ "
            Case "4"
                If Mid(X, 1, 1) ^ tot + Mid(X, 2, 1) ^ tot + Mid(X, 3, 1) ^ tot + Mid(X, 4, 1) ^ tot = X Then Msg = Msg & X & "_ "
            Case "5" 'ecc ecc
            Case "6" 'ecc ecc
            Case "7" 'ecc ecc
            Case "8" 'ecc ecc
            Case "9" 'ecc ecc
            Case "10" 'ecc ecc
         End Select
    Next X
    MsgBox Msg
End Sub

Una function che vuole come argomento il numero di cifre da elaborare (3 per i numeri da 100 a 999, .... 8 per i numeri da 10.000.000 a 99.999.999, con più di 8 cifre nSum va in overflow e andrebbe dichiarata as LongLong)

Function Narcisi(nEsp As Long) As String
  Dim nstart As Long
  Dim nStop As Long, j As Long, k As Long
  Dim nSum As Long 'LongLong sopra le 8 cifre se la versione di Excel lo consente
  Dim sNum As String, vNum As Variant
  Dim sRet As String
  
  nstart = 10 ^ (nEsp - 1)
  nStop = 10 ^ (nEsp) - 1
  
  
  For j = nstart To nStop
    sNum = CStr(j)
    vNum = Split(StrConv(sNum, vbUnicode), vbNullChar)
    nEsp = Len(sNum)
    nSum = 0
    For k = 0 To nEsp - 1
      nSum = nSum + vNum(k) ^ nEsp
    Next k
    If nSum = j Then
      sRet = sRet & "numero " & j & vbCrLf
    End If
  Next j
  Narcisi = IIf(sRet > "", sRet, "nessun numero")
End Function

esempio di chiamata:

Sub test()
  Dim sRis As String
  sRis = Narcisi(4)
  Debug.Print sRis
  MsgBox sRis
End Sub

numero 146511208

numero 472335975

numero 534494836

numero 912985153

Raffaele53 ha scritto:

sRet = sRet & "numero " & j & vbCrLf Narcisi = IIf(sRet > "", sRet, "nessun numero")

& è &

> è > 

quindi sRet = sRet & "numero " & j & vbCrLf

Narcisi = IIf(sRet > "", sRet, "nessun numero")