Numeri Narcisi

[albatros54Moderatore albatros54 Karma: 89 pts]

Salve, da un po di tempo che non mi faccio sentire, vorrei proporre un quesito:

Scrive un algoritmo che mi trovi i numeri "NARCISI" in un range di numeri a nostra scelta (es: da 100 a 5000..), una volta trovato il numero , informare l'utente con una Msgbox dove si evidenzia il numero. Non è difficile!!

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

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

[LukeRedsPartecipante LukeReds Karma: 19 pts]

ciao

numero narciso la prossima volta che lo sentirò sarà la seconda....

inserendo il numero minore in A1 ed il maggiore in A2 (nessun controllo di numericità/validità, variabili da dichiarare)

Sub numeri()
For i = Cells(1, 1) To Cells(2, 1)
   For j = 1 To Len(i)
      n = Mid(i, j, 1) ^ Len(i) + n
   Next j
   If n = i Then MsgBox "numero narciso...." & i
   n = 0
Next i
End Sub


'1 sola msgbox
Sub numeriX()
For i = Cells(1, 1) To Cells(2, 1)
   For j = 1 To Len(i)
      n = Mid(i, j, 1) ^ Len(i) + n
   Next j
   If n = i Then tot = tot & ", " & i
   n = 0
Next i
MsgBox "numeri " & tot
End Sub

[scossaPartecipante scossa Karma: 37 pts]

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

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Ciao scossa, puoi ricontrollare queste due righe? Mi vengono segnalate in rosso.
sRet = sRet & "numero " & j & vbCrLf
Narcisi = IIf(sRet > "", sRet, "nessun numero")

[scossaPartecipante scossa Karma: 37 pts]

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")

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Ottimo

[albatros54Moderatore albatros54 Karma: 89 pts]

Questo è il mio algoritmo:

Sub NumeroNarcisio()
    Dim cella As Range
    Dim numeroStr As String
    Dim i As Integer
    Dim Team_Members() As Integer
    uriga = Worksheets("Foglio1").Cells(Rows.Count, "A").End(xlUp).Row

    Worksheets("Foglio1").Range("A1").CurrentRegion.ClearContents
    Range("A1").Select
    Range("A1") = InputBox("Digita il numero iniziale")



    Inizio = Range("A1").Value
    passo = CStr(InputBox("passo"))
    Fine = CStr(InputBox("Digita il numero finale"))
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
                         Step:=passo, Stop:=Fine, Trend:=False
    Finebis = Cells(Rows.Count, 1).End(xlUp).Row
    For K = Inizio To Fine
        a = Len(CStr(K))

        numeroStr = CStr(K)
        Set cellaTrovata = Range("a1:a" & Finebis).Cells.Find(What:=K)
        cellaTrovata.Select

        For i = 1 To Len(numeroStr)

            ReDim Team_Members(1 To a)
            Team_Members(i) = Mid(numeroStr, i, 1)
            elevapotenza = (Mid(numeroStr, i, 1)) ^ a

            cellaTrovata.Offset(0, i) = elevapotenza

            somma = elevapotenza + somma
            If somma = K Then
                cellaTrovata.Interior.ColorIndex = 3
                cellaTrovata.Offset(0, i + 1) = somma
                MsgBox ("numero Narcisio   " & somma)

            End If


        Next i

        cellaTrovata.Offset(0, i) = somma
        somma = 0

    Next
End Sub

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[scossaPartecipante scossa Karma: 37 pts]

Ciao,

non l'ho provato, troppe variabili non dichiarate, ma immagino che funzioni "parzialmente", nel senso che se metti ad esempio passo 2 darà errore per tutti i numeri dispari (ma poi che utilità ha un passo diverso da 1?)

[albatros54Moderatore albatros54 Karma: 89 pts]

scossa ha scritto:

troppe variabili non dichiarate

fretta, manca "Option Explicit" che mi controlla le variabili.

scossa ha scritto:

(ma poi che utilità ha un passo diverso da 1

potevo eliminare "l'Inputbox" assegnando " 1" alla varibile passo

 

Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
Sempre il mare, uomo libero, amerai!
( Charles Baudelaire )

[Aldo ErcoliniPartecipante Aldo Ercolini Karma: 19 pts]

Ciao a tutti ragazzi, era da un po' che non entravo, hi visto questo post e vi voglio mostrare anche il mio algoritmo:

Sub NumeriNarcisi()
    Dim DaNumero As Long, ANumero As Long, Numero As Long, x As Long, y As Long, i As Long, Totale As Long, Risultato As String, Numeri() As String, strNumero As String

    DaNumero = InputBox("Digitare da che numro iniziare cercare i numeri narcisi")
    ANumero = InputBox("Digitare fino a che numero cercare i numeri narcisi")
    
    Risultato = "Numeri Narcisi Trovati:" & vbNewLine
    Numero = DaNumero

    For i = DaNumero To ANumero
    
        strNumero = CStr(Numero)
        y = Len(strNumero) - 1
        Numeri() = Split(StrConv((Numero), vbUnicode), vbNullChar)
        
        For x = 0 To y
        
            Totale = Totale + CLng(Numeri(x)) ^ (y + 1)
            
        Next x
        
        If Totale = Numero Then
            Risultato = Risultato & Numero & vbNewLine
        End If
        
        Numero = Numero + 1
        Totale = 0
    Next i
  
    MsgBox Risultato
  
End Sub

Colgo l'occasione per fare a tutti i migliori Auguri di una serena Pasqua.

[Autore]

Articoli