function

[giorgioa]

Scusami Anthony, giuro che faccio tutto il possibile a spiegarmi e non farti perdere tempo

La PyramidSub che hai scritto va benissimo
l'altra macro che ha quasi le stesse caratteristiche di PyramdSub la devi correggere, penso in modo semplice

La PyramidSub inizia a calcolare facendo resto 9 i numeri

1) Invece a questa nuova cambiare nome
2)scartare il primo calcolo resto 9 e calcolare direttamente resto 90

fine seconda macro

[Anthony47]

Quindi forse questa?

Codice: Seleziona tutto

Sub PyramidSub990()
Dim oArr(), wArr(), j As Long, Dbg As Boolean
Dim I As Long, ooArr(), iArr, Trans As Long, oPos As String
Dim ModAB As Long, JJ As Long
'
Dbg = False
ModAB = 90
iArr = Range("A20:J25").Value           '<<< L'Area di input
oPos = "P20"                              '<<< 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 ModAB
                    If oArr(I) = 0 Then oArr(I) = ModAB
                Next I
                wArr = oArr
            If Dbg Then Call DbgPrint(j, wArr)
            Else
            'Debug.Print JJ, wArr(1), wArr(2)
                Trans = (wArr(1) + 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

Questa manipola tutti i calcoli usando somma con modulo 90

[giorgioa]

Salve,

OK per la conclusione della seconda macro

funziona perfettamente

Grazie di aver risolto entrambi i problemi

RISOLTO