function

[giorgioa]

Salve a tutti,

cortesemente se c'è qualcuno disposto a scrivere una function

per piramidare dei numeri.

Possibilmente deve poter fare la piramide anche con 3 numeri e poter piramidare fino a 10 numeri.

cioè per 3 numeri oppure 5 numeri fino a poter inserire 10 numeri massimo

Grazi a che mi aiuterà.

[Anthony47]

Dovresti pero' spiegare meglio che cosa intendi, poi probabilmente un aiutino arriverà....

[giorgioa]

Ben detto e mi adatto:

elenco 10 numeri puramente casuali e qualsiasi numero non deve superare io 90
aggiungo che non ha nessuna importanza che un numero maggiore sia prima o viceversa:

faccio conto che alla prima riga riporto i numeri
alla seconda riga devo dare di resto il numero a 9 per es 88=7; 10=1 ecc
per spiegarmi riporto la successione dei dati in seconda riga
30-22-15-77-03-13-66-77-89-90 (probabile che ci sia qualche numero uguale quello che conta è il calcolo)
-3--4---6--5---3--4---3--5--8---0 (numero sopra corrisponde numero sotto)
la terza riga deve fare la somma dei numeri a 2 alla volta sommando il primo col secondo, il secondo col terzo ecc
con la terza riga i numeri diventano 9 venendo a mancare il primo numero
----7---1--2---8--7---7--8--4---8 anche in questa riga la somma dei 2 numeri dara di resto se supera il 9 infatti il 4+6=10 resto 9 sarà 1
man mano che si effettua il conteggio riga per riga sempre dando resto 9 alla somma di 2 numeri i numeri diminuiscono
e alla fine rimarrà un solo numero
naturalmente la function tutti questi calcoli non ce li deve dimostrare ma dare solo in numero finale

[giorgioa]

dei numeri elencati riporto il risultato, cosa + importante

= 70,

riporto un'altra serie di numeri col risultato finale

12-2-70-38-82-27-54-11-19-30 = 3

Salve

[Anthony47]

Humm... Se il risultato dei numeri 30-22-15-77-03-13-66-77-89-90 deve far 70 allora non ho capito niente...

Comunque prova con questo codice:

Codice: Seleziona tutto

Function Pyramid(ByRef myRan As Range) As Long
Dim oArr(), wArr, J As Long, Dbg As Boolean
'
Dbg = True
wArr = Application.Intersect(myRan, Range(myRan.Cells(1, 1), myRan.Cells(1, 1).End(xlToRight))).Value
wArr = Application.WorksheetFunction.Index(wArr, 1, 0)
If Dbg Then Call DbgPrint(J, wArr)
'
Do
J = J + 1
If J > 100 Then Pyramid = 666: Exit Function
    If UBound(wArr) > 2 Then
        ReDim oArr(1 To UBound(wArr) - 1)
        For I = 1 To UBound(oArr)
            oArr(I) = wArr(I) + wArr(I + 1)
            oArr(I) = oArr(I) - (Int(oArr(I) / 9) * 9)
        Next I
        wArr = oArr
    If Dbg Then Call DbgPrint(J, wArr)
    Else
        Pyramid = wArr(1) + wArr(2)
        Pyramid = Pyramid - (Int(Pyramid / 9) * 9)
        Exit Function
    End If
    DoEvents
Loop
End Function

Sub DbgPrint(ByVal JJ As Long, ByRef pArr)
Dim I As Long, pStr As String
For I = 1 To UBound(pArr)
    pStr = pStr & pArr(I) & "-"
Next I
Debug.Print JJ, Left(pStr, Len(pStr) - 1)
End Sub


Poi in una cella scrivi la formula

Codice: Seleziona tutto

=Pyramid(A1:M1)

Presuppone che i tuoi numeri siano scritti da A1 verso destra per un max di 13 numeri

Prova...

[giorgioa]

82 77 60 15 70 1 35 44 8 2

per favore prova questa sequela di numeri alla fine deve dare
ultime 2 celle fa 1 e poi 8 vero che resto fa 0 ma deve fare 1 and 8 =18

per calcoli già fatti se durante il calcolo se per es 4+5 fara 9 se ZERO lo fa 9
potrebbe succedere che è un esempio nelle ultime 2 celle potremmo avere
penultima a sx 9 e penultima a dx 5 in quel caso se zero = 9 avremmo 9 and 5 = 95 ma deve dare 5

spero di non aver imbrogliato la matassa

[giorgioa]

per matassa intendo gomitolo

[Anthony47]

Perdona, ma non ho capito cosa dici.
Puoi fare degli esempi ben separati?

[Marius44]

Ciao
Vediamo di trovare il capofilo della matassa (gomitolo)

Atteso che i dati sono in A1:J1 prova con questa funzione

Codice: Seleziona tutto

Option Explicit

Function Mod9()
Dim i As Long, j As Long, uc As Long, rg As Long
Dim nri(), seq()
rg = 2
uc = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim nri(1 To 10)
ReDim seq(1 To 10)
For i = 1 To uc
  nri(i) = Cells(rg - 1, i) Mod 9
Next i
For j = 1 To UBound(nri)
  seq = nri
  For i = LBound(nri) + 1 To UBound(nri) - 1
    nri(j) = (seq(i) + seq(i + 1)) Mod 9
  Next i
Next j
Mod9 = seq(UBound(seq))
End Function]

Nella casella che vuoi inserisci =Mod9

Fai sapere. Ciao,
Mario

[giorgioa]

89 9 16 42 38 50 56 58 11 44 numerazione
8 9 7 6 2 5 2 4 2 8 tasformo il nr in resto 9
- 8 7 4 8 7 7 6 6 1 inizio il calcolo somma sempre con resto 9
- - 6 2 3 6 5 4 3 7 quando la somma dei 2 nr fa 9 non deve essere
- - - 8 5 9 2 9 7 1 uguale 0 ma 9
- - - - 4 5 2 2 7 8 --
- - - - - 9 7 4 9 6 --
- - - - - - 7 2 4 6 --
- - - - - - - 9 6 1 --
- - - - - - - - 6 7 --
- - - - - - - - - 4
- - - - - - - - - -

mi da =rifriga la tua function Marius

[Anthony47]

inizio il calcolo somma sempre con resto 9
quando la somma dei 2 nr fa 9 non deve essere uguale 0 ma 9

Lavoro su queste informazioni e dimentico che a un certo punto avevi scritto "ultime 2 celle fa 1 e poi 8 vero che resto fa 0 ma deve fare 1 and 8 =18"

Sostituisci tutto il codice che ti avevo dato con questo:

Codice: Seleziona tutto

Function PyramidA(ByRef myRan As Range) As Long
Dim oArr(), wArr, J As Long, Dbg As Boolean
'
Dbg = True
wArr = Application.Intersect(myRan, Range(myRan.Cells(1, 1), myRan.Cells(1, 1).End(xlToRight))).Value
wArr = Application.WorksheetFunction.Index(wArr, 1, 0)
If Dbg Then Call DbgPrint(J, wArr)
'
Do
J = J + 1
If J > 100 Then PyramidA = 666: Exit Function
    If UBound(wArr) > 2 Then
        ReDim oArr(1 To UBound(wArr) - 1)
        For i = 1 To UBound(oArr)
            oArr(i) = (wArr(i) + wArr(i + 1)) Mod 9
            If oArr(i) = 0 Then oArr(i) = 9
        Next i
        wArr = oArr
    If Dbg Then Call DbgPrint(J, wArr)
    Else
        PyramidA = (wArr(1) + wArr(2)) Mod 9
        If PyramidA = 0 Then PyramidA = 9
        Exit Function
    End If
    DoEvents
Loop
End Function

Sub DbgPrint(ByVal JJ As Long, ByRef pArr)
Dim i As Long, pStr As String
For i = 1 To UBound(pArr)
    pStr = pStr & pArr(i) & "-"
Next i
Debug.Print JJ, Left(pStr, Len(pStr) - 1)
End Sub


Poi prova con la formula

Codice: Seleziona tutto

=PyramidA(A1:M1)

Valgono le istruzioni gia' date: dati di partenza da A1 verso destra; saranno presi in considerazione (con la formula data) i dati max fino a M1

La formula di Mario dà errore perche' Mod9 viene interpretato come l'indirizzo di una cella; prova cambiando Mod9 con ModMod9

Ciao

[Marius44]

Ciao
Non mi sembra di avere letto prima che se il resto fosse stato 0(zero) bisognava cambiarlo in 9.
Tentiamo con la seguente macro (che scrive i risultati dalla riga 2, valori sempre nell'intervallo A1:J1)

Codice: Seleziona tutto

Option Explicit

Sub Prova()
Dim uc As Long, i As Long, j As Long
uc = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To uc
  If Cells(1, i) Mod 9 = 0 Then
    Cells(2, i) = 9
  Else
    Cells(2, i) = Cells(1, i) Mod 9
  End If
Next i
For j = 1 To 10
  For i = j To Cells(1, Columns.Count).End(xlToLeft).Column - 1
    If (Cells(j + 1, i) + Cells(j + 1, i + 1)) Mod 9 = 0 Then
      Cells(j + 2, i + 1) = 9
    Else
      Cells(j + 2, i + 1) = (Cells(j + 1, i) + Cells(j + 1, i + 1)) Mod 9
    End If
  Next i
Next j
Stop
End Sub


Se va bene si vedrà (ma puoi provare tu stesso) a cambiare la Sub in Function
Fai sapere. Ciao,
Mario

PS - Scusate l'accavallamento ma stavo scrivendo quando Anthony ha pubblicato.

[giorgioa]

io sto provando

prima la function di Anthony in quale modulo

la macro di Mario per richiamare la sequela cosa ci scrivo nella cella k1

[giorgioa]

Scusami Anthony c'è la variabile I non dichiarata

ho provato con string = nulla
ho provato con integer

vorrei provbare ma non ho idea

[Marius44]

Ciao
Consiglio: fai una cosa alla volta altrimenti ... ci confondiamo tutti.
Nella mia macro non c'è nulla da inserire in K1. Apri l'Editor di VBA (Alt+F11) selezioni l'inizio della macro e la lanci (clicca sul pulsantino in alto con il triangolo con la punta verso sinistra)

Ciao,
Mario

[Anthony47]

Per le varie modalita' con cui lanciare una macro, potresti guardare qui: viewtopic.php?f=26&t=103893&p=647678#p647678

Quanto alla variabile non dichiarata, non e' obbligatorio dichiararla, ma dichiararla e' meglio ed evita di commettere errori.
Se hai impostato Option Explicit allora devi obbligatoriamente dichiarare tutto; immagino questo sia il tuo caso, quindi aggiungi la dichiarazione di "i":

Codice: Seleziona tutto

Dim oArr(), wArr, J As Long, Dbg As Boolean, i as long

Buona serata a tutti

[Francesco53]

Un saluto a tutti
Francesco

[Anthony47]

France', che succede?

[Francesco53]

Ciao Anthony, ciao Marius44, passavo ed ho voluto salutare.
Risolvere i pensieri dei giocatori del lotto è quasi sempre una impresa.
Francesco

[giorgioa]

Salve Antohony,

la tua function funziona solo che ci sarebbe da apportare una variante
cioè la function deve fermarsi al penultimo passaggio e dare il risultato
unendo i valori delle 2 celle
es 9 e 7 dovrebbe essere 97 però siccome si supera il 9o effettuare la sottrazione di 97-90
e il risultato sarebbe 7
mentre se avessimo 7 e 9 sarà = 79 numero finale

Io utilizzo la dichiarazione delle variabili da dichiarare.

Sperando di essere perdonato ...