function

[giorgioa]

Salve Franxcesco,

permettimi un cordiale saluto e ringraziamento
per quanti aiuti fattomi.

Volevo dire solo forse i problemi di cui uno principale
non essendo tecnici di spiegare quanto vi chiediamo in modo esaustivo
questa la difficoltà;
però nel problema che vi si pone se non c'è difficolta
i vostri studi o esperienze rimarrebbero come ad un inizio.

Ciao Francesco e sempre un grazie...

[giorgioa]

Salve Anthony

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 ...

[Anthony47]

Quindi

Codice: Seleziona tutto

Function PyramidB(ByRef myRan As Range) As Long
Dim oArr(), warr, j As Long, Dbg As Boolean
Dim I As Long
'
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 PyramidB = 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
        PyramidB = (warr(1) * 10 + warr(2)) Mod 90
        If PyramidB = 0 Then PyramidB = 90
        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


La parte variata e’ la Function PyramidB, che sostituisce la Function PyramidA; mentre la Sub DbgPrint non e’ cambiata rispetto a prima

Prova e fai sapere...

D:\DDownloads\[MULTI_C30521.xlsm]Foglio3

[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


Sperando di essere perdonato ...

[giorgioa]

Ok la funcition funziona con la correzione

Il motivo la formula della function la devo inserire in una macro
che conteggerà 6 7000 righe
non è lenta ma puoi darci una spintarella per farla velocizzare?
"chi non sa dice ... , eventualmente non farci caso"

[giorgioa]

Salve Marius,

mi devi scusare se preferisco la function di Anthony
proprio perche se non sbaglio non funziona su una sola riga?

Ma ti ringrazio della partecipazione

[Anthony47]

Se nel codice dell’attuale PyramidB metti Dbg=False allora la Function sara’ nolto piu’ veloce

L’alternativa e’ una unica PyramidArr che processa l’intero blocco di righe. Corrisponde al seguente codice:

Codice: Seleziona tutto

Function PyramidArr(ByRef myRan As Range) As Variant
Dim oArr(), wArr(), j As Long, Dbg As Boolean
Dim I As Long, ooArr(), iArr, Trans As Long
'
Dbg = False
iArr = myRan.Value
ReDim ooArr(1 To Parent.Caller.Rows.Count, 1 To 1)
'
For JJ = 1 To UBound(iArr)
    Trans = 0
    ReDim wArr(1 To UBound(iArr, 2))
    For j = 1 To UBound(iArr, 2)
        If iArr(JJ, j) <> "" Then
            Trans = Trans + 1
            wArr(Trans) = iArr(JJ, j)
        End If
    Next j
    If Trans > 1 Then
        ReDim Preserve wArr(1 To Trans)
    'If Dbg Then Call DbgPrint(j, wArr)
        j = 0
        Do
        j = j + 1
        If j > 100 Then PyramidArr = 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
                Trans = (wArr(1) * 10 + wArr(2)) Mod 90
                If Trans = 0 Then Trans = 90
                ooArr(JJ, 1) = Trans
                Exit Do
            End If
            DoEvents
        Loop
        If JJ >= UBound(ooArr) Then
            ooArr(1, 1) = "ESPANDERE"
            PyramidArr = ooArr
            Exit For
        End If
    End If
Next JJ
PyramidArr = ooArr
End Function


Poi vai accanto alla tabella con i numerellida “piramidare” e scrivi la formula

Codice: Seleziona tutto

=PyramidArr(A1:J2000)

L’intervallo e’ da adattare al tuo caso.
I tempi di esecuzione dovrebbero essere visibilmente ridotti rispetto alla PyramidB ripetuta per n-mila volte

La formula va introdotta in forma di matrice, su un numero di celle sufficienti a contenere il risultato; cioe’ (ragionevolmente) su tante righe quante righe di dati sorgenti hai.
Se il numero di righe non e’ sufficiente a contenere tutte le righe di risultato allora in cella 1 (del risultato) troverai la scritta “ESPANDERE”
Per inserire la formula in forma di matrice:
a) selezionare l’area, es M1:M10
b) inserire nella barra della formula la formula desiderata, es =PyramidArr(A1:J2000) (volutamente ho messo la formula in 10 righe ma ne serviranno molte di piu’)
c) confermare la formula con Contr-Maiusc-Enter
In M1 dovrebbe comparire la scritta ESPANDERE e nelle celle sottostanti i primi 9 risultati

d) avendo capito che devi “espandere” l’area del risultato, seleziona da M1 fino a M2010; premere F2 (edit formula), premere Contr-Maiusc-Enter. Questa procedura inserira’ la formula in M1:M2010, quindi potrai vedere tutti i risultati e in piu' le ultime 10 righe conterranno 0

Lo step d) spiega come “allungare” l’area della formula; accorciarla purtroppo e’ meno semplice:
-bisogna cancellare la formula in tutto l’intervallo e poi riscriverla solo nell’intervallo piu' corto voluto

Prova e fai sapere...

D:\Dropbox\SHAREDz\[MULTI_C30521.xlsm]Foglio3 (2)

[giorgioa]

Anthony volevo chiederti,
quando ti ho chiesto della function pyramidA
di mettere insieme i numeri del penultimo passaggio
hai fatto la modifica anche alla parte inziale della Function PyramidA

il principio è semplre quello di dare resto ai primi numeri e poi passare alle somme con resto 9
quando rimangono le ultime 2 cifre portare in unica cella i valori della prima e seconda cella
spero di essermi spiegato

[Anthony47]

La PyramidA e' del mese scorso, quindi non ricordo come funzionava.
In questi giorni ho aggiunto la gestione degli ultimi 2 numeri residui, passando da Somma con modulo 9 al concatenamento con modulo 90; modifica che e' presente pero' nella PyramidB e non nella PyramidA

Se qualcosa non torna fai un esempio con una sequenza specifica, indicando quale risultato viene ora calcolato e cosa invece bisognerebbe far uscire

[giorgioa]

Volevo dire che me la vedo un po complicata assegnare l'array
in fin dei conti ci impiega circa un minurto

Paziento.

Per quanto riguarda la precisazione precedente
specifico meglio
con pyramidA è importante che la functione trasformi inizialmente i numeri in resto 9
l'unico dato si deve avere il valore delle 2 celle (penultimo passo) e senza resto es 1 e 8 =18

Per quanto riguarda la pyramidB senza trasformare i numeri con resto 9
quindi eliminerebbe una riga sommare sin dall'inizio i numeri ma questa volta con mod 90

[giorgioa]

QUESTO QUANTO VORREI HO RIPORTATO GLIV STESSI NUMERI PER ENTRAMBI GLI SVILUPPI CHE DANNO DIFFERENZA.

RESTO 9
72 12 42 57 31
9 3 6 3 4
--- 3 9 9 7
--- --- 3 9 7
--- --- --- 3 7
--- --- --- --- 37
RESTO 9
18 67 87 7 26
9 4 6 7 8
--- 4 1 4 6
--- --- 5 5 1
--- --- --- 1 6
--- --- --- --- 16
RESTO 9
67 86 41 60 31
4 5 5 6 4
--- 9 1 2 1
--- --- 1 3 3
--- --- --- 4 6
--- --- --- --- 46

RESTO 90
72 12 42 57 31
--- 84 54 9 88
--- --- 48 63 7
--- --- --- 21 70
--- --- --- --- 1
RESTO 90
18 67 87 7 26
--- 85 64 4 33
--- --- 59 68 37
--- --- --- 37 15
--- --- --- --- 52
RESTO 90
67 86 41 60 31
--- 63 37 11 1
--- --- 10 48 12
--- --- --- 58 60
--- --- --- --- 28

[Anthony47]

Forse stiamo facendo confusione...
Eravamo partiti con una Function Pyramid, che poi avevo corretta in Function PyramidA, che innfine avevo corretto in Function PyramidB (per concatenare gli ultimi due risultati in Modulo 90).
Quindi per me qui c’e’ una sola Function PyramidB e le altre sono delle bozze sostituite dalla versione finale PyramidB.
Ora non so se la PyramidB (o una delle versioni precedenti) dà il risultato che chiedi oppure no, l’ultimo messaggio non me l’ha chiarito


Quanto alla versione “Array” forse l’ho fatta piu’ complessa di quanto serve, perche’ probabilmente la versione “Macro” e’ operativamente piu’ semplice.

Quindi ti propongo questa Macro:

Codice: Seleziona tutto

Sub PyramidSub()
Dim oArr(), wArr(), j As Long, Dbg As Boolean
Dim I As Long, ooArr(), iArr, Trans As Long, oPos As String
'
Dbg = False
iArr = Range("A1:J2000").Value          '<<< L'Area di input
oPos = "P1"                              '<<< La posizione dell'output
'
ReDim ooArr(1 To UBound(iArr), 1 To 1)
'
For JJ = 1 To UBound(iArr)
    Trans = 0
    ReDim wArr(1 To UBound(iArr, 2))
    For j = 1 To UBound(iArr, 2)
        If iArr(JJ, j) <> "" Then
            Trans = Trans + 1
            wArr(Trans) = iArr(JJ, j)
        End If
    Next j
    If Trans > 1 Then
        ReDim Preserve wArr(1 To Trans)
        j = 0
        Do
        j = j + 1
        If j > 100 Then ooArr(JJ, 1) = 666
            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
                Trans = (wArr(1) * 10 + wArr(2)) Mod 90
                If Trans = 0 Then Trans = 90
                ooArr(JJ, 1) = Trans
                Exit Do
            End If
            DoEvents
        Loop
    End If
Next JJ
Range(oPos).Resize(UBound(ooArr), 1).Value = ooArr
End Sub


In testa, nelle due istruzioni marcate <<<, va inserita l’area di input e l’area di output.

All’occorrenza si lancia la Sub PyramidSub, che scrivera’ per ogni riga di input il valore piramidale calcolato, senza doversti preoccupare di doverla impostare con l’area delle formula a matrice.

Ovviamente la Macro va ri-lanciata se i dati in input cambiano, mentre la Function avrebbe calcolato automaticamente i nuovi valori in caso di cambiamento.

[giorgioa]

La macro che mi hai proposto va bene ed è un fulmine nell'esecuzione
poichè lavoro su + fogli aventi le stesse posizioni questa mi sta bene

ho fatto 2 esempi di cio che volevo quella col resto 9 va bene nei 6
esempi riportati la macro soddisfa i primi 3 esempi con in testa resto 9

ora se con un ultimo sforzo se puoi cambiare il nome alla macro e
fare una modifica Invece di calcolare resto 9 dovrebbe calcolare resto 90
con un particolare iniziale di calcolo che consiste in questo apparentemente
ininfluente.
La macro attuale trasforma i numeri in resto 9 invece quella col resto 90
deve saltare questo calcolo e passare al calcolo sommatorio tra un numero e
l'altro col resto 90
I risultati del calcolo sono gli altri 3 dopo i primi 3 con la scritta resto 90
Fai quest'ultimo sforzo(pazientevole) che saremmo a cavallo dell'asino

[giorgioa]

Nel lanciare l pYRAMIDsUB mi chiedeva di dichiarare la variabile
jj l'ho dichiarata as Long andrebbe bene?

[giorgioa]

Salve Anthony,

ma per farla funzionare nella cella cosa ci devo scrive?

Per esempio i dati da piramidare sono in c3:g3 e l'ho dichiarate nel codice
dove si ottiene il risultato ed anche questo AD3 e l'ho dichiarate nel codice

Salve

[giorgioa]

cerco di spiegarmi meglio

la sub PyramidSub dovrebbe funzionare ad una cera riga di codice in un'altra macro in modo conseguenziale

per farla funzionare cos' cosa riporto nell'altra macro

[giorgioa]

cerco di spiegarmi meglio

la sub PyramidSub dovrebbe funzionare ad una cera riga di codice in un'altra macro in modo conseguenziale

per farla funzionare cos' cosa riporto nell'altra macro

[giorgioa]

QUESTO QUANTO VORREI HO RIPORTATO GLIV STESSI NUMERI PER ENTRAMBI GLI SVILUPPI CHE DANNO DIFFERENZA.

RESTO 9
72 12 42 57 31
9 3 6 3 4
--- 3 9 9 7
--- --- 3 9 7
--- --- --- 3 7
--- --- --- --- 37
RESTO 9
18 67 87 7 26
9 4 6 7 8
--- 4 1 4 6
--- --- 5 5 1
--- --- --- 1 6
--- --- --- --- 16
RESTO 9
67 86 41 60 31
4 5 5 6 4
--- 9 1 2 1
--- --- 1 3 3
--- --- --- 4 6
--- --- --- --- 46

RESTO 90
72 12 42 57 31
--- 84 54 9 88
--- --- 48 63 7
--- --- --- 21 70
--- --- --- --- 1
RESTO 90
18 67 87 7 26
--- 85 64 4 33
--- --- 59 68 37
--- --- --- 37 15
--- --- --- --- 52
RESTO 90
67 86 41 60 31
--- 63 37 11 1
--- --- 10 48 12
--- --- --- 58 60
--- --- --- --- 28

[giorgioa]

Salve Anthony,

sono riuscito a far funzionare la tua sub nella macro mia

Come vedi qualche post messo è inutile ma a volte si ha bisogno anche capire cosa e come fare.

Come ultima cosa l'ho scritto precedentemente cioè a quella macro che mi hai scritto

cortesemente cambiare solo il nome e eliminare solo il passaggio di trasformare i numeri

in resto 9 mentre il calcolo di somma farlo a Mod 90.

Non penso ti sia un problema.

E chiudo l'argomento.

Aspetto un tuo commento , quello che fai e mi dici va sempre bene.

Salve

[Anthony47]

Mi sono preso il wekend libero

...e adesso continuo a non capire che cosa funziona e che cosa no

Mi sembra che chieda una funzione che faccia tutti i calcoli in modulo 90; se e' così allora forse questa funzione (che lavora a livello di riga singola, non fa in blocco una intera tabella come fa la PyramydArr):

Codice: Seleziona tutto

Function Pyramid90(ByRef myRan As Range) As Long
Dim oArr(), wArr, j As Long, Dbg As Boolean
Dim I As Long, ooArr(), ModABC As Long
'
Dbg = False
ModABC = 90
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 Pyramid90 = 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 ModABC
            If oArr(I) = 0 Then oArr(I) = ModABC
        Next I
        wArr = oArr
        If Dbg Then Call DbgPrint(j, wArr)
    Else
        Pyramid90 = (wArr(1) + wArr(2)) Mod 90
        If Pyramid90 = 0 Then Pyramid90 = 90
        Exit Function
    End If
    DoEvents
Loop
End Function


Poi non ho capito che nome devo cambiare e perche'