Moderatori: Anthony47, Flash30005
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
=Pyramid(A1:M1)
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]
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"inizio il calcolo somma sempre con resto 9
quando la somma dei 2 nr fa 9 non deve essere uguale 0 ma 9
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
=PyramidA(A1:M1)
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
Dim oArr(), wArr, J As Long, Dbg As Boolean, i as long
Torna a Applicazioni Office Windows
user function di excel con argomenti facoltativi Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 5 |
Function per ottenere numero colonna se data = ..... Autore: syncoopate |
Forum: Applicazioni Office Windows Risposte: 4 |
Office 2016 problemi compatibilità Private Declare Function Autore: deniel69 |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 17 ospiti