Excel e gli applicativi Microsoft Office Sfida numero 2: numeri palindromi

Voto per la Sfida n. 2

Scegli a chi dare il tuo voto per questa sfida (sondaggio attivo fino al giorno 8 marzo)

  • albatros5471.43%5 votes
  • patel0%0 votes
  • scossa14.29%1 vote
  • Textomb0%0 votes
  • Luca7314.29%1 vote
  • vecchio frac0%0 votes
LoginRegistrati
Stai vedendo 25 articoli - dal 1 a 25 (di 40 totali)
  • Autore
    Articoli
  • #13309 Risposta

    vecchio frac
    Senior Moderator
      171 pts

      Per questa sfida (proposta da Luca73) si tratta di giocare con i numeri palindromi.
      Abbiamo già in passato affrontato un esercizio per verificare se un numero è palindromo oppure no.
      Ecco quindi la sfida: "Scrivere una routine VBA che, dato un numero intero e positivo di n cifre, restituisca il numero palindromo più vicino che sia superiore al numero dato".
      Si possono usare tutte le tecniche note.

      Esempi:

      784351 ---> 784487
      80123  ---> 80208
      6532   ---> 6556

      Le proposte verranno accettate solo fra cinque giorni da adesso: quindi potrete pubblicare i vostri post da domenica 3 marzo 2019 a partire dalle ore 12. Questa discussione viene chiusa da ora e riaperta al momento giusto.

      Eventuali richieste di chiarimento potranno essere fatte in chat o direttamente alla mail della Redazione.

      Il vincitore verrà stabilito mediante sondaggio aperto a tutta la comunità: il sondaggio durerà qualche giorno (verrà stabilito al momento della chiusura della sfida). Solo le risposte che arriveranno in questa discussione verranno prese in considerazione.
      In caso di parità si terrà conto del criterio cronologico. Ognuno può pubblicare tutte le soluzioni che vuole, ma solo l'ultima postata verrà tenuta in considerazione in caso di parità di voti ottenuti.

      Il vincitore avrà la soddisfazione di aver partecipato e di aver illustrato qualche tecnica magari nuova o interessante. Inoltre avrà l'onore di proporre la sfida successiva!

      Quindi pronti? ...via! cominciate a pensarci, ci rivediamo qui a partire da domenica prossima!

      #13515 Risposta
      patel
      patel
      Moderatore
        43 pts

        propongo questa UDF

        Option Explicit
        
        Function palindromo(cella As Double) As Double
        Dim L As Integer, L2 As Integer, s1 As String, pal As String, s As String
        s = LTrim(Str(cella))
        L = Len(s)
        L2 = L / 2 + 0.1
        s1 = Left(s, L2)
        If L Mod 2 = 1 Then
          pal = s1 & StrReverse(Left(s1, Len(s1) - 1))
        Else
          pal = s1 & StrReverse(s1)
        End If
        If Val(pal) <= Val(s) Then
          s1 = Str(Val(s1) + 1)
          If L Mod 2 = 1 Then
            pal = s1 & StrReverse(Left(s1, Len(s1) - 1))
          Else
            pal = s1 & StrReverse(s1)
          End If
        End If
        palindromo = Val(pal)
        End Function
        #13516 Risposta
        albatros54
        albatros54
        Moderatore
          54 pts

          For Dummies:

          Sub palindromo1()
              Dim a As String
              Dim somma As Variant
          
              a = CDbl(InputBox("dammi il valore"))
              somma = a
              Do
                  somma = somma + 1 ' segno - per palindromo inferiore
              Loop Until somma = StrReverse(somma)
              MsgBox "Il numero palindromo superiore a " & a & " è " & somma
          End Sub

          altra senza "StrReverse"

          Sub palindromo2()
          
              Dim lngCont As Integer, lngpalindromo As Integer, lngb As String
              '
              Dim stra As String
              Dim lnglun As Long
              '
              Dim strEstr As String, strFinl As String
              '
          
              lngCont = 1
              stra = InputBox("dammi il valore")
              lnglun = Len(stra)
              lngb = CDbl(stra)
              Do Until lngCont >= lnglun
                  strEstr = Mid(lngb, lngCont, 1)
                  strFinl = Mid(lngb, lnglun + 1 - lngCont, 1)
                  If strEstr = strFinl Then
                      lngCont = lngCont + 1
                  Else
          
                      lngb = lngb + 1
                      lnglun = Len(lngb)
                      If strEstr <> strFinl Then
                          lngCont = 1
                      End If
                  End If
          
              Loop
          
              MsgBox "Il numero palindromo superiore a " & stra & " è " & lngb
          
          End Sub

          Funzione, da inserire in cella:

          Public Function palindromo3(ByVal stra As Variant)
              Dim lngCont As Integer, lngpalindromo As Integer, lngb As String
              Dim lnglun As Long
              Dim strEstr As String, strFinl As String
              
          
              lngCont = 1
              lnglun = Len(stra)
              lngb = stra
              Do Until lngCont >= lnglun
                  strEstr = CDbl(Mid(lngb, lngCont, 1))
                  strFinl = CDbl(Mid(lngb, lnglun + 1 - lngCont, 1))
                  If strEstr = strFinl Then
                      lngCont = lngCont + 1
                  Else
          
                      lngb = lngb + 1
                      lnglun = Len(lngb)
                      If strEstr <> strFinl Then
                          lngCont = 1
                      End If
                  End If
          
              Loop
              palindromo3 = lngb
          
          End Function

          Allego file con tutte le routine

           

          Edit by VF: ho aggiustato un pochino il format di questo post che si era un po' sballato 🙂

           

          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 )
          Allegati:
          You must be logged in to view attached files.
          #13525 Risposta
          patel
          patel
          Moderatore
            43 pts

            Albatros, i miei complimenti per la prima  come ho fatto a non pensarci ?  

            #13526 Risposta

            vecchio frac
            Senior Moderator
              171 pts

              Mi associo a patel, è bellissima  

              #13527 Risposta

              vecchio frac
              Senior Moderator
                171 pts

                Chiusura della sfida con accettazione delle proposte: martedì 5 marzo ore 16! Poi via col televoto 😀

                #13535 Risposta
                patel
                patel
                Moderatore
                  43 pts

                  Aggiungo la UDF derivata dalla prima di albatros

                  Function fpalindromo(cella As Long) As Long
                      Dim somma As Long
                      somma = cella
                      Do
                          somma = somma + 1 ' segno - per palindromo inferiore
                      Loop Until somma = StrReverse(somma)
                      fpalindromo = somma
                  End Function
                  #13536 Risposta

                  vecchio frac
                  Senior Moderator
                    171 pts

                    Albatros esagerato, vuoi stravincere?     

                    @patel, la tua soluzione non restituisce il palindromo superiore corretto in caso di numeri a due cifre come per esempio 55 (deve essere 66), dacci un'occhiata; inoltre trattando con numeri Long restituisce errore di Overflow quando ne superi i limiti (prova con 12345678901).

                    @albatros, le soluzioni numero 2 e 3 non restituiscono il palindromo superiore corretto per numeri come 66 o 88. 

                    #13537 Risposta
                    albatros54
                    albatros54
                    Moderatore
                      54 pts

                      vecchio frac ha scritto:

                      , le soluzioni numero 2 e 3 non restituiscono il palindromo superiore corretto per numeri come 66 o 88.

                      basta aggiungere 1 alla variabile lngb, sia nella prima che nella seconda

                      lngb = CDbl(stra) + 1

                       

                      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 )
                      #13539 Risposta
                      scossa
                      scossa
                      Partecipante
                        2 pts

                        Ciao,

                        arrivo in ritardo (tanto per cambaiare); avevo scritto una prima soluzione con la stessa logica di Albatros (la più intuitiva, basat sul valore numerico):

                        Function fPalin(ByVal sVal As String, Optional ByVal bSelf As Boolean = True) As Long
                          
                          If sVal = StrReverse(sVal) And bSelf Then sVal = sVal + 1 'doppia conversione implicita
                          Do While sVal <> StrReverse(sVal)
                            sVal = CStr(CLng(sVal) + 1)
                          Loop
                          
                          fPalin = StrReverse(sVal)
                        
                        End Function

                        ma le prestazioni decadono all'aumentare della lunghezza della stringa (si possono superare le migliaia di loop)

                        quindi ho pensato di lavorare sulla stringa, evitando i loop :

                        Function fPalindro(ByVal sVal As String) As Long
                         
                          Dim sLeft As String, sRight As String, sLeftPal As String
                          Dim nLen As Long, nLenL As Long
                          
                          If sVal = StrReverse(sVal) Then sVal = CStr(CLng(sVal + 1))
                          nLen = Int(Len(sVal) / 2 + 0.5)
                          nLenL = IIf(Len(sVal) Mod 2, nLen - 1, nLen)
                          sLeft = Left(sVal, nLen)
                          sRight = Right(sVal, nLen)
                          sLeftPal = StrReverse(sLeft)
                          If --sLeftPal < --sRight Then
                            sLeft = CStr(--sLeft + 1)
                          End If
                          sLeftPal = StrReverse(Left(sLeft, nLenL))
                          fPalindro = --(sLeft & sLeftPal)
                          
                        End Function

                         

                        #13540 Risposta

                        vecchio frac
                        Senior Moderator
                          171 pts

                          Che bello! abbiamo qui anche scossa, grazie     

                          #13544 Risposta
                          Textomb
                          Textomb
                          Partecipante

                            Anche se mi pare di rifriggere una frittata...

                            Sub N_Palindromi()
                            
                                Dim myN As Long
                                
                                myN = Application.InputBox("Inserisci un numero intero, positivo", Type:=1)
                                
                                If myN < 0 Then Exit Sub
                                
                                    If myN < 9 Then
                                        myN = myN + 1
                                    ElseIf myN < 11 Then
                                        myN = 11
                                    Else
                                        F_Palindromo myN
                                    End If
                                
                                MsgBox Format(myN, "#,#")
                                
                            End Sub
                            
                            Function F_Palindromo(nVal As Long) As Long
                                
                                Dim nPal As Long
                                Dim nChr As Long
                                Dim Pvt As Long
                                Dim halfN As Long
                                Dim halfNpvt As Long
                                Dim Bln_Odd As Boolean
                                
                                nChr = Len(CStr(nVal))
                                
                                Bln_Odd = Application.IsOdd(nChr)
                                
                                If Bln_Odd Then ' Se nChr è dispari estraggo il suo mediano Pvt
                                    Pvt = Mid(CStr(nVal), ((nChr / 2) + 0.5), 1)
                                    halfN = Left(CStr(nVal), (nChr / 2) - 0.5)
                                    nPal = CLng(halfN & Pvt & StrReverse(halfN))
                                Else
                                    ' Il numero di caratteri è pari.
                                    halfN = Left(CStr(nVal), nChr / 2)
                                    nPal = CLng(halfN & StrReverse(halfN))
                                End If
                                
                                
                                ' Verifico la condizione iniziale
                                ' Se è così, termino la funzione...
                                If nPal > nVal Then
                                    nVal = nPal
                                    Exit Function
                                End If
                                
                                    ' Se sono qui vuol dire che il palindromo è inferiore al numero iniziale.
                                    ' Aggiungo 1 e faccio un altro giro...
                                    If Bln_Odd Then ' Si tratta di un numero dispari...
                                        halfNpvt = CLng(halfN & Pvt) + 1
                                        nVal = halfNpvt & Application.Rept("0", (nChr / 2 - 0.5))
                                    Else ' Si tratta di un numero pari...
                                        halfN = halfN + 1
                                        nVal = halfN & Application.Rept("0", nChr / 2)
                                    End If
                                    
                                    F_Palindromo nVal
                                    
                            End Function
                            
                            #13551 Risposta
                            patel
                            patel
                            Moderatore
                              43 pts

                              vecchio frac ha scritto:

                              @patel, la tua soluzione non restituisce il palindromo superiore corretto in caso di numeri a due cifre come per esempio 55 (deve essere 66), dacci un'occhiata; inoltre trattando con numeri Long restituisce errore di Overflow quando ne superi i limiti (prova con 12345678901).

                              ho corretto

                              #13552 Risposta
                              Luca73
                              Luca73
                              Partecipante
                                44 pts

                                Ciao

                                Ecco le mie

                                la prima trova solo il palindrono superiore

                                Sub PalLTSup()
                                Dim MioNumero As Long
                                Dim NumPalMax As Long
                                Dim NumPari As Boolean
                                Dim VettoreParti(1 To 3)
                                Const Alto = 1
                                Const Medio = 2
                                Const Basso = 3
                                Dim LungMioNum
                                
                                MioNumero = Range("C3")
                                If MioNumero = StrReverse(MioNumero) Then
                                    NumPalMax = MioNumero
                                Else
                                    LungMioNum = Len(Format(MioNumero, "0"))
                                    NumPari = Int(LungMioNum / 2) = LungMioNum / 2
                                    VettoreParti(Alto) = MioNumero \ (10 ^ (Int(LungMioNum / 2 + 0.5)))
                                    If Not NumPari Then
                                        VettoreParti(Medio) = (MioNumero \ (10 ^ (Int(LungMioNum / 2 - 0.5)))) Mod 10
                                    Else
                                        VettoreParti(Medio) = ""
                                    End If
                                    VettoreParti(Basso) = MioNumero Mod (10 ^ (Int(LungMioNum / 2)))
                                    If CLng(StrReverse(VettoreParti(Alto))) > VettoreParti(Basso) Then
                                        NumPalMax = CLng(VettoreParti(Alto) & VettoreParti(Medio) & StrReverse(VettoreParti(Alto)))
                                    Else
                                        NumPalMax = CLng(CLng(VettoreParti(Alto) & VettoreParti(Medio)) + 1) & StrReverse(Left((CLng(VettoreParti(Alto) & VettoreParti(Medio)) + 1), Int(LungMioNum / 2)))
                                    End If
                                
                                End If
                                Range("E5") = NumPalMax
                                End Sub

                                La seconda trova sia il superiore chel'inferiore

                                Sub PalLT01()
                                Dim MioNumero As Long
                                Dim NumPalMin As Long
                                Dim NumPalMax As Long
                                Dim NumPari As Boolean
                                Dim VettoreParti(1 To 3)
                                Const Alto = 1
                                Const Medio = 2
                                Const Basso = 3
                                Dim LungMioNum
                                
                                MioNumero = Range("C3")
                                If MioNumero < 10 Then
                                    NumPalMax = MioNumero
                                    NumPalMin = MioNumero
                                ElseIf MioNumero = 10 Then
                                    NumPalMax = 11
                                    NumPalMin = 9
                                ElseIf MioNumero = StrReverse(MioNumero) Then
                                    NumPalMax = MioNumero
                                    NumPalMin = MioNumero
                                Else
                                    LungMioNum = Len(Format(MioNumero, "0"))
                                    NumPari = Int(LungMioNum / 2) = LungMioNum / 2
                                    
                                    VettoreParti(Alto) = MioNumero \ (10 ^ (Int(LungMioNum / 2 + 1.5) - 1))
                                    If Not NumPari Then
                                        VettoreParti(Medio) = (MioNumero \ (10 ^ (Int(LungMioNum / 2 + 1.5) - 2))) Mod 10
                                    Else
                                        VettoreParti(Medio) = 0
                                    End If
                                    VettoreParti(Basso) = MioNumero Mod (10 ^ (Int(LungMioNum / 2)))
                                    If NumPari Then
                                        If CLng(StrReverse(VettoreParti(Alto))) > VettoreParti(Basso) Then
                                            NumPalMax = CLng(VettoreParti(Alto) & StrReverse(VettoreParti(Alto)))
                                            If VettoreParti(Alto) = 10 ^ (LungMioNum / 2 - 1) Then
                                                NumPalMin = CLng(String(LungMioNum - 1, "9"))
                                            Else
                                                NumPalMin = CLng((VettoreParti(Alto) - 1) & StrReverse((VettoreParti(Alto) - 1)))
                                            End If
                                        Else
                                            NumPalMax = CLng((VettoreParti(Alto) + 1) & StrReverse((VettoreParti(Alto) + 1)))
                                            NumPalMin = CLng(VettoreParti(Alto) & StrReverse(VettoreParti(Alto)))
                                        End If
                                    Else
                                        If CLng(StrReverse(VettoreParti(Alto))) > VettoreParti(Basso) Then
                                            NumPalMax = CLng(VettoreParti(Alto) & VettoreParti(Medio) & StrReverse(VettoreParti(Alto)))
                                            If CLng(VettoreParti(Alto) & VettoreParti(Medio)) = 10 ^ (LungMioNum / 2 - 0.5) Then
                                                NumPalMin = CLng(String(LungMioNum - 1, "9"))
                                            Else
                                                NumPalMin = CLng(CLng(VettoreParti(Alto) & VettoreParti(Medio)) - 1) & StrReverse((CLng(VettoreParti(Alto) & VettoreParti(Medio)) - 1) \ 10)
                                            End If
                                        Else
                                            NumPalMax = CLng(CLng(VettoreParti(Alto) & VettoreParti(Medio)) + 1) & StrReverse((CLng(VettoreParti(Alto) & VettoreParti(Medio)) + 1) \ 10)
                                            NumPalMin = CLng(VettoreParti(Alto) & VettoreParti(Medio) & StrReverse(VettoreParti(Alto)))
                                        End If
                                    End If
                                
                                End If
                                Range("C5") = NumPalMax
                                Range("C6") = NumPalMin
                                End Sub

                                 

                                #13553 Risposta
                                Luca73
                                Luca73
                                Partecipante
                                  44 pts

                                  Giusto per dettagliare.

                                  Io nelle mie macro ho considerato il "superiore" come "uguale o superiore" pertanto il palindromo superiore di 55 è 55 stessso.

                                  Così pure per l'inferiore. Pertanto quando in partenza avevo un numero singolo o già palindromo ho considerato se stesso.

                                  Ciao a tutti

                                   

                                  #13554 Risposta

                                  vecchio frac
                                  Senior Moderator
                                    171 pts

                                    patel ha scritto:

                                    ho corretto

                                    Grazie a tutti ragazzi! Viste le numerose proposte, e poichè molte giocano sulle performances, sto preparando un piccolo test per il benchmark, così possiamo misurare i millisecondi. Inoltre sto valutando se pubblicare anche la mia soluzione, non vorrei però fare la solita figura   

                                    #13555 Risposta

                                    vecchio frac
                                    Senior Moderator
                                      171 pts

                                      Textomb ha scritto:

                                      Anche se mi pare di rifriggere una frittata...

                                      Grazie mille textomb! Ti si rivede !    

                                      #13556 Risposta

                                      vecchio frac
                                      Senior Moderator
                                        171 pts

                                        Luca73 ha scritto:

                                        Giusto per dettagliare.

                                        Grazie Luca! il proponente della sfida 😀

                                        Luca73 ha scritto:

                                        nelle mie macro ho considerato il "superiore" come "uguale o superiore"

                                        Quando mi avevi proposto la sfida non lo avevi precisato, ed è per questo che ho fatto la precisazione a patel. Pertanto a questo punto possiamo accettare e considerare valide le proposte che restituiscono lo stesso numero come "uguale o superiore" se è già palindromo (5555 = 5555).

                                        #13557 Risposta

                                        vecchio frac
                                        Senior Moderator
                                          171 pts

                                          @textomb controlla la tua seconda proposta, non mi dà risultati corretti.

                                          ?f_palindromo(5670)
                                           0 

                                          Cosa sbaglio?

                                          #13562 Risposta
                                          Textomb
                                          Textomb
                                          Partecipante

                                            Si tratta di una funziona ricorsiva... Viene richiamata dalla Sub N_Palindromi()...

                                            Se la fai viaggiare in assenza della sub chiamante non da i risultati attesi.

                                            Fai sapere...

                                            #13563 Risposta

                                            vecchio frac
                                            Senior Moderator
                                              171 pts

                                              Ah ecco, non sono stato attento    scusami   

                                              #13565 Risposta
                                              patel
                                              patel
                                              Moderatore
                                                43 pts

                                                vecchio frac ha scritto:

                                                Grazie a tutti ragazzi! Viste le numerose proposte, e poichè molte giocano sulle performances, sto preparando un piccolo test per il benchmark, così possiamo misurare i millisecondi.....

                                                In un caso del genere secondo me le performances non sono prioritarie, conta l'idea più brillante e che utilizza meno righe di codice

                                                #13567 Risposta

                                                vecchio frac
                                                Senior Moderator
                                                  171 pts

                                                  Certamente! Conterebbe anche l'idea più originale, o quella più ricercata, o quella più inusuale... poichè si lascia la scelta al giudizio popolare, ognuno può adottare il metro che ritiene più idoneo. Secondo me anche le performances possono essere rilevanti, almeno a livello statistico   

                                                  #13568 Risposta

                                                  vecchio frac
                                                  Senior Moderator
                                                    171 pts

                                                    In effetti in questa prova le differenze di performances non sono significative. I millisecondi impiegati sono decisamente trascurabili (da zero a 16 nei casi peggiori). Ho testato ogni routine con cento numeri da "palindromizzare" (uguali per tutti) e l'unica osservazione rilevante è che in generale fra tutte solo le ultime due routines di Albatros soffrono qualche rallentamento nell'elaborare alcune conversioni (in circa il sei-otto per cento dei casi e comunque entro i 16 ms).

                                                    #13573 Risposta
                                                    scossa
                                                    scossa
                                                    Partecipante
                                                      2 pts

                                                      vecchio frac ha scritto:

                                                      In effetti in questa prova le differenze di performances non sono significative. I millisecondi impiegati sono decisamente trascurabili ....

                                                      Avevo fatto anch'io un test, con circa 34000 righe: sul mio pc (non troppo performante) le routine con il ciclo impiegano mediamente 10 sec. (Do .. Until ... Loop), o 9 sec. (Do .. While .. Loop), mentre l'altra mia proposta impiega poco più di 5 secondi ... direi che in assoluto la differenza c'è, nell'uso pratico invece dipende da quanti numeri devi elaborare.

                                                       

                                                    LoginRegistrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 40 totali)
                                                    Rispondi a: Sfida numero 2: numeri palindromi
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni:



                                                    vecchio frac - 2750 risposte

                                                    patel
                                                    patel - 1089 risposte

                                                    albatros54
                                                    albatros54 - 1062 risposte

                                                    Marius44
                                                    Marius44 - 1000 risposte

                                                    Luca73
                                                    Luca73 - 798 risposte