Per Joe91

[Mat]

Caro Giorgio,
data la facilità e velocità di trovarti in questo forum mi rivolgo a te perchè in passato ti sei occupato dell'argomento e sai a cosa mi riferisco.

Lo script che segue fu fatto da Gaspare per aggiornarmi l'archivio dinamico:

'Rif. 0901_40b Garga funzione PdR(aggiornamento archivio)

Sub main()
r1=1 '<== imposta la prima ruota. LS cicla da questa fino alla ruota r2
r2=12 '<== ultima ruota. LS cicla fino a questa.
'in questo esempio cicla da BA a NZ


ini=EstrazioneFin

'Scrivi " QUADRO ESTESO DEGLI ESTRATTI" &chr(10) ,1
'--------------------------------------------------------------------
'Scrivi "DATA ESTR "& " |",1,0
'For r=r1 To r2 '<== Imposta la ruota
'If r=11 Then r=12
'Scrivi FormatSpace(SiglaRuota(r),15),1,0
'For p= 1 To 5
'If p=5 Then Scrivi "|",0,0
'If r= r2 And p= 5 Then Scrivi "",1,1
'Next
'Next

'For es= ini To EstrazioneFin
'Scrivi DataEstrazione(es)& " |",0,0
'For r=r1 To r2 '<== Imposta la ruota
'If r=11 Then r=12
'For p= 1 To 5
'n=Estratto(es,r,p)
'Scrivi FormatSpace(n,2,1)& " ",0,0
'If p=5 Then Scrivi "|",0,0
'If r= r2 And p=5 Then Scrivi "",0,1
'Next
'Next
'Next
'Scrivi

'---------------------------------------------------
'Scrivi " QUADRO ESTESO DELLE POSIZIONI di RITARDO (all'es precedente) dei numeri sortiti" &chr(10) ,1
'Scrivi "DATA ESTR "& " |",1,0

For r=r1 To r2
If r=11 Then r=12
'Scrivi FormatSpace(SiglaRuota(r),15),1,0
'For p= 1 To 5
'If p=5 Then Scrivi "|",0,0
If r= r2 And p= 5 Then Scrivi "",1,1
'Next
Next

For es= ini To EstrazioneFin
esp=es-1
Scrivi DataEstrazione(es)& ".",0,0
For r=r1 To r2
If r=11 Then r=12
Messaggio es & " "& SiglaRuota(r)
For p= 1 To 5
n=Estratto(es,r,p)
Scrivi FormatSpace(PdR(esp,r,n),2,1)& ".",0,0
'Scrivi Format2(PdR(esp,r,n),2,1)& ".",0,0


'If p=5 Then Scrivi ".",0,0
If r= r2 And p=5 Then Scrivi "",0,1
Next
Next
Next
End Sub


Function PdR(e,r,n)

ru=r : co=91 :c=0 : Redim vett(0)

Do While co >1
For es=e To fin-500 step-1
For q= 5 To 1 step -1
x=0
For i= 0 To c
If Estratto(es,ru,q) = vett(i) Then x=x+1
Next

If x=0 Then
co=co-1
c=c+1
Redim preserve vett(c)
vett(c)=Estratto(es,ru,q)
If Estratto(es,ru,q)=n Then ' <=== NOTA: se la funzione elabora una posizione uguale a quella
PdR=co '"richiamata dallo script", assegna a NPR il numero in esame
Exit Do ' interrompe l'esecuzione del Ciclo Do..
End If
End If
Next
Next
Loop


End Function

Il risultato di questo script ad esempio dopo l'ultimo concorso è questo:

<<13.11.2014. 7.80.60.24.43.57.45.47.75.16.64.50.41.55. 3.69.17.31.28.65.55.30.88.29.87.84.38.15.90.65.17.57.80.71.52.46. 4.32.20.65.86.71.55.20.21.59.61.16.12.87.45. 8.82. 7.42.>>

A me invece servirebbe in quest'altra forma:

<<13-11-201407806024435745477516645041550369173128655530882987843815906517578071524604322065867155202159611612874508820742>>

In questo modo mi sarebbe di più immediata lettura per alcuni miei programmi.
Ho provato da solo a fare alcune modifiche ma ci sono riuscito solo parzialmente e non so bene se è affidabile, pertanto chiedo aiuto a te e naturalmente a chiunque voglia aiutarmi.
Spero di essere riuscito nella trasmissione dello script sul forum.
Grazie a tutti anticipatamente e buona domenica,

Matteo

 

[fillotto]

se l'output ti va bene così?

13.11.2014- 780602443574547751664504155 3691731286555308829878438159065175780715246 43220658671552021596116128745 882 742

è semplice:
questo:

 Scrivi FormatSpace(PdR(esp,r,n),2,1)& ".",0,0

diventa:

 Scrivi FormatSpace(PdR(esp,r,n),2,1)& "",0,0

nota: i numeretti sono preceduti da uno spazio vuoto al posto dello "0" .
Per curiosità noto che sono 55 numeri e cosa rappresenterebbero?

 

[Mat]

Grazie a fillotto,
in quella forma ci sono riuscito anch'io; mentre vorrei esattamente la forma da me riportata per non doverlo fare ogni volta manualmente.
Cioè la data invece di questa

13.11.2014-

mi deve dare questa

13-11-2014

come da me riportato ed invece degli spazi vuoti davanti ai numeretti vorrei appunto gli "0"

I numeri sono esattamente le posizioni occupate sul tabellone analitico dei 55 numeri sorteggiati sulle 11 ruote.
Ciao e grazie,

Matteo

 

[Joe91]

Ciao Matteo.

Prova così:

Sub Main()
r1=1 '<== imposta la prima ruota. LS cicla da questa fino alla ruota r2
r2=12 '<== ultima ruota. LS cicla fino a questa.
'in questo esempio cicla da BA a NZ


ini=EstrazioneFin

'Scrivi " QUADRO ESTESO DEGLI ESTRATTI" &chr(10) ,1
'--------------------------------------------------------------------
'Scrivi "DATA ESTR "& " |",1,0
'For r=r1 To r2 '<== Imposta la ruota
'If r=11 Then r=12
'Scrivi FormatSpace(SiglaRuota(r),15),1,0
'For p= 1 To 5 
'If p=5 Then Scrivi "|",0,0
'If r= r2 And p= 5 Then Scrivi "",1,1
'Next 
'Next

'For es= ini To EstrazioneFin
'Scrivi DataEstrazione(es)& " |",0,0
'For r=r1 To r2 '<== Imposta la ruota
'If r=11 Then r=12 
'For p= 1 To 5 
'n=Estratto(es,r,p) 
'Scrivi FormatSpace(n,2,1)& " ",0,0
'If p=5 Then Scrivi "|",0,0
'If r= r2 And p=5 Then Scrivi "",0,1
'Next 
'Next
'Next
'Scrivi

'---------------------------------------------------
'Scrivi " QUADRO ESTESO DELLE POSIZIONI di RITARDO (all'es precedente) dei numeri sortiti" &chr(10) ,1
'Scrivi "DATA ESTR "& " |",1,0

For r=r1 To r2 
If r=11 Then r=12
'Scrivi FormatSpace(SiglaRuota(r),15),1,0
'For p= 1 To 5 
'If p=5 Then Scrivi "|",0,0
If r= r2 And p= 5 Then Scrivi "",1,1
'Next 
Next

For es= ini To EstrazioneFin 
esp=es-1
DE = Replace(DataEstrazione(es),".","-")& ""
Scrivi DE,0,0
For r=r1 To r2 
If r=11 Then r=12 
Messaggio es & " "& SiglaRuota(r)
For p= 1 To 5 
n=Estratto(es,r,p) 
'Scrivi FormatSpace(PdR(esp,r,n),2,1)& ".",0,0
Scrivi Format2(PdR(esp,r,n))& "",0,0


'If p=5 Then Scrivi ".",0,0
If r= r2 And p=5 Then Scrivi "",0,1
Next 
Next
Next
End Sub


Function PdR(e,r,n)

ru=r : co=91 :c=0 : ReDim vett(0) 

Do While co >1
For es=e To fin-500 Step-1 
For q= 5 To 1 Step -1 
x=0 
For i= 0 To c 
If Estratto(es,ru,q) = vett(i) Then x=x+1
Next

If x=0 Then
co=co-1 
c=c+1 
ReDim Preserve vett(c)
vett(c)=Estratto(es,ru,q)
If Estratto(es,ru,q)=n Then ' <=== NOTA: se la funzione elabora una posizione uguale a quella 
PdR=co '"richiamata dallo script", assegna a NPR il numero in esame
Exit Do ' interrompe l'esecuzione del Ciclo Do.. 
End If
End If 
Next 
Next 
Loop


End Function

Cordiali saluti

 

[Mat]

Ciao Giorgio,
sempre perfetto: è esattamente identico a quello che ti ho chiesto.
Con questo mi hai agevolato di molto in alcuni problemi di aggiornamento archivi che ho incontrato nelle ultime estrazioni.
Grazie a te, un abbraccio e buona domenica,

Matteo

 

[Joe91]

Ciao Giorgio,
sempre perfetto: è esattamente identico a quello che ti ho chiesto.
Con questo mi hai agevolato di molto in alcuni problemi di aggiornamento archivi che ho incontrato nelle ultime estrazioni.
Grazie a te, un abbraccio e buona domenica,

Matteo

Ciao Matteo,

Mi è gradita l'occasione per ricordare che con LuigiB, s'erano corretti alcuni difettucci riguardo l'Archivio Dinamico di Spaziometria.

Da allora Spaziometria ha un suo archivio delle posizioni aggiornato automaticamente ... fruibile e facilmente esportabile.

Dunque esso è utile, per aggiornare e controllare altro, come nel tuo caso.

Lo script necessario a Spaziometria è molto più semplice, perchè non richiede calcoli, ed è quello che rilascio qui di seguito:

Sub Main()
Scrivi "Per Aggiornamento Achivio Dinamico",1
 For Es = EstrazioneFin To EstrazioneFin : Messaggio es
  DE = DataEstrazione(Es) : DT = Replace(DE,".","-")
  Scrivi DT & "",0,0
  For R = 1 To 12
   If R <> 11 Then
    For P = 1 To 5
     Scrivi Format2(CInt(Estratto(Es,R,P,1))) & "",0,0
    Next
   End If
  Next
  Scrivi
 Next
End Sub

Cordiali saluti.

 

[Mat]

Ciao Giorgio,
ti ringrazio per quest'altra possibilità.
Utilizzo lo script che ti ho postato perchè dopo ogni estrazione finora automaticamente on line alcuni programmi, come quello di Gam, mi aggiornavano tutti gli archivi senza uso di script a parte L8+ che aggiornavo con questo script dopo ogni concorso.
Da un paio di estrazioni ciò non avveniva più pertanto ho pensato di usare questo script che mi fornisce i numeri estratti di volta in volta nel formato in cui mi sono richiesti dai programmi dopo la modifica che ora mi hai fatto.
Trattandosi di un concorso per volta per me è molto semplice incollare ora la stringa nei vari programmi ed ho risolto il problema grazie a te.
In caso di necessità naturalmente ora terrò in conto anche quest'altra possibilità.
Ti ringrazio ancora e buona serata,

Matteo

 

[Joe91]

Ciao Matteo.

Come sai, recentemente, alcuni siti ... sono diventati "inutilizzabili" per l'aggiornamento degli archivi.

S'è rinnovato ed attualizzato, l'annoso problema.

Ho redatto pertanto, anche, un piccolo script adatto all'aggiornamento dell'archivio ordinario di L8.

L'output è ben organizzato per essere compatibile ... è copiabile ed incollabile nel suo NotePad.

Da quest' ultimo "col mouse" ...

* Selezionando "Ogni Estrazione" (dalla prima all'ultima una alla volta)

* Premendo Control+X ... essa viene trasferita dal WordPad alla memoria del PC, da dove ...

* Premendo Control+E ... essa viene inserita in L8 ... non appena viene

* Confermata.

Poi, è sufficiente, se necessario, ripetere le precedenti operazioni ...

per ogni estrazione utile a completare l'archivio.

Sub Main()
	Fin = EstrazioniArchivio : Ini = Fin - 10
	Scrivi "Per Aggiornamento Achivio ORDINARIO L8 By Joe",1 : Scrivi
	For Es = Ini To Fin : Messaggio es
		DE = DataEstrazione(Es) : DT = Replace(DE,".","/")
		Scrivi DT,1
		For R = 1 To 12
			If R <> 11 Then
				Scrivi SiglaRuota(R)& " ",1,0
				Scrivi StringaEstratti(Es,R)
			End If
		Next
		Scrivi
	Next
End Sub