i legend
Premium Member
importante
non quotate lo script per favore
ciao la funzione si chiama piramide Zetrix
bisogna capire e controllare se funziona bene
bisogna passargli un array numerico
se si passa una stringa non funziona
se nell array vengono inseriti valori non numerici non funziona
provate a fare le verifiche se trovate degli errori proviamo a corregere ma non lo posso garantire pervhè potri non esserne capace
non garantisco che funzioni correttamente
salvo errori ed omissis
non quotate lo script per favore
ciao la funzione si chiama piramide Zetrix
bisogna capire e controllare se funziona bene
bisogna passargli un array numerico
se si passa una stringa non funziona
se nell array vengono inseriti valori non numerici non funziona
provate a fare le verifiche se trovate degli errori proviamo a corregere ma non lo posso garantire pervhè potri non esserne capace
non garantisco che funzioni correttamente
salvo errori ed omissis
Codice:
Option Explicit
Dim S
S = "controllare che la routine faccia quanto richiesto"
S = S & vbCrLf & "controllare che i risultati ottenuti siano esatti"
S = S & vbCrLf & "script su richiesta utente zetrix"
S = S & vbCrLf & "NOTA BENE:"
S = S & vbCrLf & "CONDIZIONI DI UTILIZZO :"
S = S & vbCrLf & "lo script è dato Così com 'è"
S = S & vbCrLf & "In NESSUN CASO L AUTORE DELLO SCRIPT POTRà ESSERE RITENUTO RESPONSABILE PER"
S = S & vbCrLf & "DANNI PER PERDITA DATI "
S = S & vbCrLf & "DANNI AL SOFTWARE"
S = S & vbCrLf & "DANNI ALL HARDWARE"
S = S & vbCrLf & "PERDITA DI DENARO"
S = S & vbCrLf & " QUALSIASI ALTRI TIPI DI DANNI ED EVENTUALI"
S = S & vbCrLf & "ESSENDO CODICE LIBERO POTREBBE ESSERE MODIFICATO DA CHIUNQUE, QUINDI LEGGERLO PER CAPIRE COSA FA"
S = S & vbCrLf & " SE NON SI ACCETTANO ANCHE UNA SOLA DI QUESTE CONDIZIONI NON UTILIZZARE LO SCRIPT"
'
Sub Main
If MsgBox(S,vbYesNo,"Disclaimer") = 6 Then
ReDim aN(0)
' SCELGO I NUMERI DA UTILIZZARE
Call ScegliNumeri(aN)
' LANCIO LA FUNZIONE
Call PiramideZetrix(aN)
Else
Exit Sub
End If
End Sub
' funzione che piramidizza come richiesto da Zetrix o per come ho capito la richiesta
Sub PiramideZetrix(aN)
Dim i,bRet
' controllo che venga passato un array
If IsArray(aN) Then
' controllo che tutti gli elementi dell array siano numerici
bRet = True
For i = 1 To UBound(aN)
If IsNumeric(aN(i)) = False Then bRet = False
Next
' se non tutti gli elementi dell array sono numerici viene scritto un messaggio d' errore e si esce dalla routine
If bRet = False Then Scrivi "Non tutti gli elementi dell array sono numerici": Exit Sub
Dim ub:ub = UBound(aN)
' se l array contiene più di 10 numeri viene restituito un messaggio d' errore e si esce dalla routine
If ub > 10 Then Scrivi "Non si possono inserire piu di 10 numeri":Exit Sub
Scrivi StringaNumeri(aN,,True)
' IMPONGO LA CONDIZIONE DI AVERE UN SOLO NUMERO
Do While ub > 1
' IMPORTANTE PER POTER SELEZIONARE IL TASTO STOP
DoEventsEx
' FUNZIONE PER INTERROMPERE LO SCRIPT
If ScriptInterrotto Then Exit Do
' DICHIARO QUANTI ELEMENTI CONTERRA L ARRAY TEMPORANEO
ReDim atemp(UBound(aN) - 1) '
' CICLO E SOMMO GLI ESTRATTI A DUE A DUE CONSECUTIVAMENTE
For i = 1 To UBound(aN) - 1
atemp(i) = Fuori90(aN(i) + aN(i + 1))
Next
' RIDICHIARO QUANTI ELEMENTI CONTIENE IL NUOVO ARRAY E LO RICOSTRUISCO
ReDim aN(UBound(atemp))
For i = 1 To UBound(atemp)
aN(i) = atemp(i)
Next
' SCRIVO LA STRINGA AD OGNI ITERAZIONE
Scrivi StringaNumeri(aN,,True)
ub = ub - 1
Loop
Else
Scrivi "Bisogna passare un array numerico alla funzione"
End If
End Sub
Ultima modifica:
