Scomposizione numero

[Roby]

Qualche anima gentile può dirmi con uno script come scomporre un numero di 5 cifre
Esempio 12345 scomposto in 1-2-3-4-5
Oppure più semplicemente ottenere il risultato della piramidazione di un numero a 5 cifre.
Grazie per l'eventuale aiuto.

 

[Mike58]

Ciao Daniel, puoi usare la funzione Mid per scomporre e la funzione Piramide per piramidare.

vedi esempio

Sub Main()
num = 123456
'----1 scala ----------------
a1 = Figura(Mid(num,1,2))
a2 = Figura(Mid(num,2,2))
a3 = Figura(Mid(num,3,2))
a4 = Figura(Mid(num,4,2))
a5 = Figura(Mid(num,5,2))
Scrivi num,1
a6 = a1 & a2 & a3 & a4 & a5
Scrivi Space(1) & a6
'---2 scala ----------------
b1 = Figura(Mid(a6,1,2))
b2 = Figura(Mid(a6,2,2))
b3 = Figura(Mid(a6,3,2))
b4 = Figura(Mid(a6,4,2))
b5 = b1 & b2 & b3 & b4
Scrivi Space(2) & b5
'------3 scala -------------
c1 = Figura(Mid(b5,1,2))
c2 = Figura(Mid(b5,2,2))
c3 = Figura(Mid(b5,3,2))
c4 = c1 & c2 & c3
Scrivi Space(3) & c4
'-----4 scala --------------
d1 = Figura(Mid(c4,1,2))
d2 = Figura(Mid(c4,2,2))
d3 = d1 & d2
Scrivi Space(4) & d3
'------------------------------
'codice piramide
aa1 = Piramide(num,6,2)
Scrivi aa1,1,1,,1,3
'------------------------------
End Sub

 

[Roby]

Azz Mike ...... più veloce della luce!!!!!!!
Grazie infinite.
Ciao ciao

 

[salvo50]

Ciao a Tutti!

Qualche tempo fa anch'io avevo chiesto questo tipo di aiuto, perchè stavo facendo uno script sul Quadrato Intellettuale di Pico Della Mirandola, e mi hanno aiutato in molti, quelli che ricordo LuigiB, Joe, I Leggend, Avio, Nelson1331, e forse qualche altro che adesso non ricordo e mi scuso, in quel topic a partire da pagina 6, ci sono tutti gli aiuti che mi hanno dato per le piramidi, ti posto il link

http://forum.lottoced.com/forum/lottoced/area-download/2049119-funzione-for-next

 

[Roby]

Ho letto salvo ma serve che il listato giri sia su spaziometria sia su desk che non accetta il codice per la piramide.
Ho risolto comunque con qualche somma, a meno che non ci sia una via più veloce.
La x sarà l'estratto
Grazie comunque di nuovo
Ciao ciao

Sub main()
For x=1 To 90
nu1 = 875&Format2(x)
x1 = CInt(Mid(nu1,1,1))
x2 = CInt(Mid(nu1,2,1))
x3 = CInt(Mid(nu1,3,1))
x4 = CInt(Mid(nu1,4,1))
x5 = CInt(Mid(nu1,5,1))
x6=x5+x4
If x6>9 Then x6= x6-9
x7=x4+x3
If x7>9 Then x7= x7-9
x8=x3+x2
If x8>9 Then x8= x8-9
x9=x2+x1
If x9>9 Then x9= x9-9
x10=x6+x7
If x10>9 Then x10= x10-9
x11=x7+x8
If x11>9 Then x11= x11-9
x12=x8+x9
If x12>9 Then x12= x12-9
x13=x12+x11
If x13>9 Then x13= x13-9
x14=x11+x10
If x14>9 Then x14= x14-9
Scrivi nu1
Scrivi x9&x8&x7&x6
Scrivi x12&x11&x10
Scrivi x13&x14
Scrivi
Next
End Sub

 

[salvo50]

Ciao a Tutti!

Quindi, serve uno script che calcola il finale della piramide, solo con i calcoli, senza inserire la funzione piramide.
C'è uno script di Joe che fa propio questo.

 Rem Scritto da Joe91 09/03/2007
Sub Main()
Dim c(20) 'Fino a 20 numeri
N = InputBox("Inaerisci il numero di cui calcolare la cuspide",,9955225032)
Scrivi FormatSpace(n,20,1) 'Formatta e scrive la formazione iniziale
For fine = Len(n) To 3 Step - 1 'Impone la fine dei calcoli per mancanza di Numeri
x = fine : r = "" 'memorizza la (nuova) lunghezza e pulisce il r isultato
For a = 1 To x : c(a) = Mid(n,a,1) : Next 'scompatta i numeri
For a = 1 To x - 1 'per ogni numero da sinisctra a destra
t = c(a) + 0 + c(a + 1) + 0 : If t >= 10 Then t = t - 10 'somma a gruppi di 2 e calcola il fuori 10
r = r & t 'Ricompone la formazione risultante
Next 'Passa al prossimo numero
Scrivi FormatSpace(r,20,1) 'Formatta e scrive la varie formazioni.
n = CStr(r) 'Rimemorizza la formazione calcolata
Next 'Ripete le operazioni di calcolo
End Sub

 

[Roby]

Salvo grazie per l'interessamento ma ho risolto con lo script che ho postato.
Ho preso spunto da quello di mike e poi ci ho messo del mio per arrivare al risultato finale.
Gira su spazio e su desk, quindi risolto il problema alla grande.
Ciao ciao

 

[joe]

Ciao Salvo.

Ti ringrazio per la citazione.

Rivedendo quello script "devo dire" che non è molto giusto quanto scrivi.

In realtà la struttura dello script è giusta per fare quello che dici,

ma i calcoli in esso sono diversi.

Quello script mi fu chiesto per altro scopo (pur simile)

pertanto LE PIRAMIDI che esso crea, SONO DIVERSE da quelle proposte in esempio.

Dunque per renderlo omologo, esso necessiterebbe, di parecchie modifiche.

 

[salvo50]

Ciao Joe!

Io l'avevo proposto come base, solo che Daniel aveva già risolto, comunque ai miei occhi è un "piccolo" (grande) capolavoro, mi spiego, puoi piramidare numeri fino a 20 cifre di partenza, e alla nona riga puoi modificare quel fuori 10 in fuori 9, fuori 8 ecc.

 

[salvo50]

Ho fatto solo qualche modifica per adattarlo

Rem Scritto da Joe91 09/03/2007
Sub Main()
Dim c(20)
For x1 = 1 To 90
n = 875 & (Format2 (x1))
Scrivi FormatSpace(n,20,1)
For fine = Len(n) To 3 Step - 1
x = fine : r = ""
For a = 1 To x : c(a) = Mid(n,a,1) : Next
For a = 1 To x - 1
t = c(a) + 0 + c(a + 1) + 0 : If t >= 9 Then t = t - 9
r = r & t
Next
Scrivi FormatSpace(r,20,1)
n = CStr(r)
Next
Scrivi
Next
End Sub

 

[Roby]

A chi puà servire, ulteriore semplificazione sfruttando le figure.
Naturalmente il numero da piramidare si può all'occorrenza accorciare e allungare.
Ciao ciao

Sub main()
For x=1 To 90
nu1 = 645&Format2(x)
x1 = Mid(nu1,1,1)
x2 = Mid(nu1,2,1)
x3 = Mid(nu1,3,1)
x4 = Mid(nu1,4,1)
x5 = Mid(nu1,5,1)
a1=Figura(x5&x4):a2=Figura(x4&x3):a3=Figura(x3&x2):a4=Figura(x2&x1)
b1=Figura(a4&a3):b2=Figura(a3&a2):b3=Figura(a2&a1)
c1=Figura(b3&b2):c2=Figura(b2&b1):c3=Fuori90(c2&c1)
Scrivi nu1:Scrivi a4&a3&a2&a1:Scrivi b1&b2&b3:Scrivi Format2(c3)
Scrivi
Next
End Sub

 

[i legend]

Ciao a tutti
ciao salvo nello script postato ( bravo)
non capisco perché sommare zero e non applicare subito la figura al risultato.se t>=9 poi t=t-9
ma la figura di 9 è 9 così viene zero .
se ho capito male mi scuso.
ciao.

 

[joe]

Se posso ... provare, a mettere un pò assieme, i vagoni di questo treno ...

che avendo scartamenti differenti si muovono su binari differenti,

diciamo che il mio algoritmo è più complicato, ma più versatile.

Quello di Mike è MOLTO rigido.

Cioè sviluppa solo ed esclusivamente i calcoli richiesti per un unico scopo.

Perciò, in quanto tale, è più piccolo più semplice, più veloce.

Il mio algoritmo lavora con le stringhe ed eseguiva un "Fuori10-(ATIPICO)"

Per convertire "in numero" i simboli della stringa ad esso corrispondenti ...

SOMMAVA ad essi "uno-ZERO".

Convertendo così "le cifre" in "numero" senza modificarne il valore assoluto.

E' uno script vecchio ed allora non esistevano (quasi) Spaziometria,

tantomeno il "Fuori9".

Rosanna fece, una funzione, delle istruzioni presenti,

cioè per questo Fuori 9/10, scritto, tra le righe dello script.

Codesta funzione fu ritenuta utile, anche per altro,

e nel tempo fu evoluta, sino a diventare il FuoriX.

Cioè l'istruzione, che è nel corredo delle funzioni di Spaziometria.

In ultimo s'è detto di un Fuori10-atipico e che i più "piramidano" in Figura.

Quindi si.

Si semplifica molto, lo script saltando il Fuori9

che per sommi capi "coincide" con la Figura di un numero.

Perdonerete la genericità dell'esposizione,

in opposizione alla rigidità di alcuni cabalisti convinti.

Option Explicit
Sub Main()

Dim X, N, Chiave 

Chiave = "875" 

	For X = 1 To 90
		ColoreTesto 1 : Scrivi Chiave,True,False 
		ColoreTesto 0 : Scrivi Format2 (X) & Space (2),True  

		N = Chiave  & Format2(X)

		ColoreTesto 2 : Scrivi Piramide(N),True : ColoreTesto 0
		Scrivi
	Next
End Sub
Function Piramide(N) 'BY JOE
Dim F,I,G,A,R,O
	Dim C(20) 'Fino a 20 numeri
	O = True
	'If Not O Then Scrivi N  'Scrive la formazione iniziale
	For F = Len(N) To 3 Step - 1 'Impone la fine dei calcoli per mancanza di Numeri
		I = F : R = "" 'memorizza la (nuova) lunghezza e pulisce il r isultato
		For A = 1 To I : C(A) = Mid(N,A,1) : Next 'scompatta i numeri
		For A = 1 To I - 1 'per ogni numero da sinisctra a destra
			G = Figura(C(A) & C(A+1)) 'Piramida in Figura
			R = R & G 'Ricompone la formazione risultante
		Next 'Passa al prossimo numero
		If Not O Then Scrivi R 'Formatta e scrive la varie formazioni.
		N = CStr(R) 'Rimemorizza la formazione calcolata
	Next 'Ripete le operazioni di calcolo
	Piramide = N
End Function