Script per la somma

pigi · 6 Marzo 2013

Salve a tutti
chiedo se è possibile fare uno script da implemantare su Spaziomatria che mi dia la somma fuori 90
dei cinque estratti di ogni ruota per verificare velocemente delle procedure che se saranno buone vi
comunicherò i risultati insieme alla tecnica.
GRAZIE
Giorgio

Thauk · 6 Marzo 2013

Ci sono già. Se vai su Tabelloni --> Quadro somme/distanze le trovi.
Comunque, questo dovrebbe andare bene.

Codice:

Sub main()
ext=CInt(InputBox("Quante estrazioni controllo? (0=ultima)","Estrazioni",0))
ini=EstrazioneFin-ext
fin=EstrazioneFin
For es=ini To fin
For r=1 To 12
a=Fuori90(SommaEstratti(es,r))
If r<>11 Then
Scrivi DataEstrazione(es)&"    "& SiglaRuota(r)&" < "& StringaEstratti(es,r)&" > Somma: "& Format2(a),1
Scrivi
End If
Next
Next
End Sub

pigi · 6 Marzo 2013

thauk, grazie , grazie gentilissimo

giorgio

Zetrix · 6 Marzo 2013

ciao pigi se vuoi impostare gioco su somma estratti questo e lo script
Sub Main()Dim amb(2),num(2),n(4)
Dim ruota(1),posta(1),poste(2)

posta(1) = 1
poste(2) = 1

'-----------------------------------------------------------------

t = 0
ini = EstrazioneFin - 0 ' <-------imposta estr precedenti
fin = EstrazioneFin

For es = ini To fin

For r1 = 1 To 10
se = SommaEstratti(es,r1)

If Int(se) = se Then
nx =(se) ' <-------- somma estratti
e1 = Fuori90(nx) '<---------imposta gioco
'e2 = Diametrale(e1) ' '
'----------------------------------------------
'---------condizione di gioco------------
amb(1) = e1
amb(2) = e2
ruota(1) = r1
t = t + 1
Scrivi "---------------------------------------------"
Scrivi DataEstrazione(es) & " [" & StringaEstratti(es,r1) & "] " & SiglaRuota(r1) & _
" | somma = " & Format2(se)
Scrivi "---------------------------------------------"
'---------------------------------------------------------------
ImpostaGiocata 1,amb,ruota,posta,2,1
co = 1
For i = 1 To 2
num(1) = amb(i)
For j = 1 To 4
co = co + 1
num(2) = n(j)
'ImpostaGiocata co,num,ruota,poste,12,2
Next
Next
'ImpostaGiocata 10,n,ruota,poste,12,2
Gioca es

End If
Next
Next

End Sub

pigi · 6 Marzo 2013

GRAZIE ANCHE A TE ZETRIX
TROVO INTERESSANTE LO SCRIPT, MA COME POSSO FARE PER ALLUNGARE I COLPI DI GIOCO,
LO SCRIPT NE PROPONE SOLO DUE, VORREI ALMENO UNA DECINA DI COLPI , SI PUO' FARE ?....
CIAO E GRAZIE DI NUOVO.
Giorgio

Zetrix · 6 Marzo 2013

vai su imposta giocata e sostituisce dove ce il 2 e semplice, poi se vuoi vedere tutte le 10 estr senza interr vai sempre su imposta giocata e sost l ultimo num 1 con 0 tutto qui ciao

pigi · 6 Marzo 2013

OK FATTO , GRAZIE ZETRIX
Giorgio

mastrogino · 7 Marzo 2013

Ciao Giorgio ti posto un script fatto dal buon Luigi credo che ti possa servire ottimo e MOLTO UTILE

___________________________________________________________________

Option Explicit
Dim ColoreFixedCol
Dim ForeColorFixedCol
Dim ColoreColSomma
Sub Main
Dim idEstr,Inizio,Fine
ReDim aT(13)
ReDim aFont(13)
ReDim aColori(13)
ReDim aForeColor(13)
ReDim aClrEvid(3)
Call Init(aT,aFont,aColori,aForeColor,aClrEvid)
Inizio = EstrazioneIni
Fine = EstrazioneFin
For idEstr = Inizio To Fine
Call EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
End Sub
Sub Init(aT,aFont,aColori,aForeColor,aClrEvid)
Dim k,i,r
ColoreFixedCol = RGB(143,143,143)
ForeColorFixedCol = vbWhite
ColoreColSomma = RGB(192,192,192)
For k = 1 To 13
aFont(k) = "Lucida console"
aColori(k) = vbCyan
aForeColor(k) = vbBlack
Next
aFont(1) = "Courier new"
aColori(1) = ColoreFixedCol
aColori(2) = ColoreColSomma
aForeColor(1) = ForeColorFixedCol
aT(1) = "Ruota"
aT(2) = "Somma"
i = 2
For r = 3 To 14
If r - 2 <> 11 Then
i = i + 1
aT(i) = " " & SiglaRuota(r - 2) & " "
End If
Next
aClrEvid(1) = vbRed
aClrEvid(2) = RGB(255,128,0)
aClrEvid(3) = vbYellow
End Sub
Sub EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Dim r,s,i,k,idRit
ReDim aV(13)
ReDim aRitPerRuota(121,3)
idRit = 0
Call InitTabella(aT,ColoreFixedCol,,,ForeColorFixedCol,"Courier new")
For r = 1 To 12
If r <> 11 Then
s = Fuori90(SommaEstratti(idEstr,r))
i = 2
aV(1) = NomeRuota(r)
aV(2) = s
For k = 1 To 12
If k <> 11 Then
i = i + 1
aV(i) = RitardoEstratto(s,idEstr,k)
idRit = idRit + 1
aRitPerRuota(idRit,1) = s ' il numero cioe la somma estratti
aRitPerRuota(idRit,2) = aV(i) ' il suo ritardo
aRitPerRuota(idRit,3) = k ' la ruota dove è stato calc il rit
End If
Next
Call ModificaColori(aV,aColori,aClrEvid)
Call AddRigaTabella(aV,aColori,,,aForeColor,aFont)
End If
Next
Call Scrivi(String(100,"_"))
Call Scrivi(GetInfoEstrazione(idEstr) & " -- Ritardo somme sulle ruote")
Call Scrivi(String(100,"_"))
Call Scrivi
Call CreaTabella
ReDim aTT(3)
aTT(1) = "Somma"
aTT(2) = "Ruota"
aTT(3) = "Ritardo"
Call InitTabella(aTT,ColoreFixedCol,,,ForeColorFixedCol,"Lucida console")
Call OrdinaMatrice(aRitPerRuota,- 1,2)
For k = 1 To 5
'Call Scrivi("Somma : " & FormatSpace(aRitPerRuota(k,1),4,True) & " Rit " & FormatSpace(aRitPerRuota(k,2),5,True) & " Ruota " & SiglaRuota(aRitPerRuota(k,3)))
aTT(1) = aRitPerRuota(k,1)
aTT(2) = SiglaRuota(aRitPerRuota(k,3))
aTT(3) = aRitPerRuota(k,2)
Call AddRigaTabella(aTT,vbCyan,,,,"Lucida console")
Next
Call Scrivi("Primi 5 più in ritardo")
Call CreaTabella
End Sub
Sub ModificaColori(aT,aColori,aClrEvid)
Dim k,j
ReDim aRit(11)
For k = 3 To 13
aRit(k - 2) = aT(k)
Next
Call OrdinaMatrice(aRit,- 1)
For k = 3 To 13
aColori(k) = vbCyan
Next
For k = 1 To UBound(aClrEvid)
For j = 3 To 13
If aT(j) = aRit(k) Then
aColori(j) = aClrEvid(k)
End If
Next
Next
End Sub

pigi · 7 Marzo 2013

Salve GIOACCHINO
grazie per lo script, il quale penso sia interessante visti i comandi che vi sono contenuti (lo dico da profano),
ma purtroppo non funziona , allego l'immagine dell'errore, sarei grato a chi mi mette in condizione di farlo
funzionare , GRAZIE.
Saluti Giorgio

mastrogino · 7 Marzo 2013

pigi ha scritto:
Salve GIOACCHINO
grazie per lo script, il quale penso sia interessante visti i comandi che vi sono contenuti (lo dico da profano),
ma purtroppo non funziona , allego l'immagine dell'errore, sarei grato a chi mi mette in condizione di farlo
funzionare , GRAZIE.
Saluti Giorgio

Vedi l'allegato 5156

CIAO NON LO CAPISCO IL PERCHE PROVA A RIDURRE LA RICERCA DALLA BARRA IN FONDO DELL'ESTRAZIONE
O ELIMINA LE PRIME RIGHE QUESTE SOTTO ELENCATE

Option Explicit
Dim ColoreFixedCol
Dim ForeColorFixedCol
Dim ColoreColSomma

feli · 7 Marzo 2013

Salve Pigi, dove ti da errore elimina lo spazio congiungi le scritte aClrEvid Ciao

Zetrix · 7 Marzo 2013

Dim ForeColorFixedCol
Dim ColoreColSomma
Sub Main
Dim idEstr,Inizio,Fine
ReDim aT(13)
ReDim aFont(13)
ReDim aColori(13)
ReDim aForeColor(13)
ReDim aClrEvid(3)
Call Init(aT,aFont,aColori,aForeColor,aClrEvid)
Inizio = EstrazioneFin - 0 '<---- imposta estrazione precedenti
Fine = EstrazioneFin
For idEstr = Inizio To Fine
Call EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
End Sub
Sub Init(aT,aFont,aColori,aForeColor,aClrEvid)
Dim k,i,r
ColoreFixedCol = RGB(143,143,143)
ForeColorFixedCol = vbWhite
ColoreColSomma = RGB(192,192,192)
For k = 1 To 13
aFont(k) = "Lucida console"
aColori(k) = vbCyan
aForeColor(k) = vbBlack
Next
aFont(1) = "Courier new"
aColori(1) = ColoreFixedCol
aColori(2) = ColoreColSomma
aForeColor(1) = ForeColorFixedCol
aT(1) = "Ruota"
aT(2) = "Somma"
i = 2
For r = 3 To 14
If r - 2 <> 11 Then
i = i + 1
aT(i) = " " & SiglaRuota(r - 2) & " "
End If
Next
aClrEvid(1) = vbRed
aClrEvid(2) = RGB(255,128,0)
aClrEvid(3) = vbYellow
End Sub
Sub EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Dim r,s,i,k,idRit
ReDim aV(13)
ReDim aRitPerRuota(121,3)
idRit = 0
Call InitTabella(aT,ColoreFixedCol,,,ForeColorFixedCol, "Courier new")
For r = 1 To 12
If r <> 11 Then
s = Fuori90(SommaEstratti(idEstr,r))
i = 2
aV(1) = NomeRuota(r)
aV(2) = s
For k = 1 To 12
If k <> 11 Then
i = i + 1
aV(i) = RitardoEstratto(s,idEstr,k)
idRit = idRit + 1
aRitPerRuota(idRit,1) = s ' il numero cioe la somma estratti
aRitPerRuota(idRit,2) = aV(i) ' il suo ritardo
aRitPerRuota(idRit,3) = k ' la ruota dove è stato calc il rit
End If
Next
Call ModificaColori(aV,aColori,aClrEvid)
Call AddRigaTabella(aV,aColori,,,aForeColor,aFont)
End If
Next
Call Scrivi(String(100,"_"))
Call Scrivi(GetInfoEstrazione(idEstr) & " -- Ritardo somme sulle ruote")
Call Scrivi(String(100,"_"))
Call Scrivi
Call CreaTabella
ReDim aTT(3)
aTT(1) = "Somma"
aTT(2) = "Ruota"
aTT(3) = "Ritardo"
Call InitTabella(aTT,ColoreFixedCol,,,ForeColorFixedCol ,"Lucida console")
Call OrdinaMatrice(aRitPerRuota,- 1,2)
For k = 1 To 5
'Call Scrivi("Somma : " & FormatSpace(aRitPerRuota(k,1),4,True) & " Rit " & FormatSpace(aRitPerRuota(k,2),5,True) & " Ruota " & SiglaRuota(aRitPerRuota(k,3)))
aTT(1) = aRitPerRuota(k,1)
aTT(2) = SiglaRuota(aRitPerRuota(k,3))
aTT(3) = aRitPerRuota(k,2)
Call AddRigaTabella(aTT,vbCyan,,,,"Lucida console")
Next
Call Scrivi("Primi 5 più in ritardo")
Call CreaTabella
End Sub
Sub ModificaColori(aT,aColori,aClrEvid)
Dim k,j
ReDim aRit(11)
For k = 3 To 13
aRit(k - 2) = aT(k)
Next
Call OrdinaMatrice(aRit,- 1)
For k = 3 To 13
aColori(k) = vbCyan
Next
For k = 1 To UBound(aClrEvid)
For j = 3 To 13
If aT(j) = aRit(k) Then
aColori(j) = aClrEvid(k)
End If
Next
Next
End Sub

mastrogino · 7 Marzo 2013

cosi dovrebbe funzionare ..fammi sapere........
c'è da impazzire .....lo copio sul post e no da spazio me metto lo spaziometria e mida lo spazio tra
aClrEvid se non ti parte e perche non sono le lettere attacate tra loro

Sub Main
Dim idEstr,Inizio,Fine
ReDim aT(13)
ReDim aFont(13)
ReDim aColori(13)
ReDim aForeColor(13)
ReDim aClrEvid(3)
Call Init(aT,aFont,aColori,aForeColor,aClrEvid)
Inizio = EstrazioneFin - 0 '<---- imposta estrazione precedenti
Fine = EstrazioneFin
For idEstr = Inizio To Fine
Call EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
End Sub
Sub Init(aT,aFont,aColori,aForeColor,aClrEvid)
Dim k,i,r
ColoreFixedCol = RGB(143,143,143)
ForeColorFixedCol = vbWhite
ColoreColSomma = RGB(192,192,192)
For k = 1 To 13
aFont(k) = "Lucida console"
aColori(k) = vbCyan
aForeColor(k) = vbBlack
Next
aFont(1) = "Courier new"
aColori(1) = ColoreFixedCol
aColori(2) = ColoreColSomma
aForeColor(1) = ForeColorFixedCol
aT(1) = "Ruota"
aT(2) = "Somma"
i = 2
For r = 3 To 14
If r - 2 <> 11 Then
i = i + 1
aT(i) = " " & SiglaRuota(r - 2) & " "
End If
Next
aClrEvid(1) = vbRed
aClrEvid(2) = RGB(255,128,0)
aClrEvid(3) = vbYellow
End Sub
Sub EseguiStat(idEstr,aT,aFont,aColori,aForeColor,aClrEvid)
Dim r,s,i,k,idRit
ReDim aV(13)
ReDim aRitPerRuota(121,3)
idRit = 0
Call InitTabella(aT,ColoreFixedCol,,,ForeColorFixedCol,"Courier new")
For r = 1 To 12
If r <> 11 Then
s = Fuori90(SommaEstratti(idEstr,r))
i = 2
aV(1) = NomeRuota(r)
aV(2) = s
For k = 1 To 12
If k <> 11 Then
i = i + 1
aV(i) = RitardoEstratto(s,idEstr,k)
idRit = idRit + 1
aRitPerRuota(idRit,1) = s ' il numero cioe la somma estratti
aRitPerRuota(idRit,2) = aV(i) ' il suo ritardo
aRitPerRuota(idRit,3) = k ' la ruota dove è stato calc il rit
End If
Next
Call ModificaColori(aV,aColori,aClrEvid)
Call AddRigaTabella(aV,aColori,,,aForeColor,aFont)
End If
Next
Call Scrivi(String(100,"_"))
Call Scrivi(GetInfoEstrazione(idEstr) & " -- Ritardo somme sulle ruote")
Call Scrivi(String(100,"_"))
Call Scrivi
Call CreaTabella
ReDim aTT(3)
aTT(1) = "Somma"
aTT(2) = "Ruota"
aTT(3) = "Ritardo"
Call InitTabella(aTT,ColoreFixedCol,,,ForeColorFixedCol,"Lucida console")
Call OrdinaMatrice(aRitPerRuota,- 1,2)
For k = 1 To 5
'Call Scrivi("Somma : " & FormatSpace(aRitPerRuota(k,1),4,True) & " Rit " & FormatSpace(aRitPerRuota(k,2),5,True) & " Ruota " & SiglaRuota(aRitPerRuota(k,3)))
aTT(1) = aRitPerRuota(k,1)
aTT(2) = SiglaRuota(aRitPerRuota(k,3))
aTT(3) = aRitPerRuota(k,2)
Call AddRigaTabella(aTT,vbCyan,,,,"Lucida console")
Next
Call Scrivi("Primi 5 più in ritardo")
Call CreaTabella
End Sub
Sub ModificaColori(aT,aColori,aClrEvid)
Dim k,j
ReDim aRit(11)
For k = 3 To 13
aRit(k - 2) = aT(k)
Next
Call OrdinaMatrice(aRit,- 1)
For k = 3 To 13
aColori(k) = vbCyan
Next
For k = 1 To UBound(aClrEvid)
For j = 3 To 13
If aT(j) = aRit(k) Then
aColori(j) = aClrEvid(k)
End If
Next
Next
End Sub

Zetrix · 7 Marzo 2013

ciao schiro' si in effetti e cosi e solo quello il problema poi funziona bene come dice anke feli

mastrogino · 7 Marzo 2013

zetrix ha scritto:
ciao schiro' si in effetti e cosi e solo quello il problema poi funziona tutto bene

grazie zetrix per la conferma stavo dando alle stelle
ciaooo

pigi · 7 Marzo 2013

OK RAGAZZI ORA FUNZIONA GRAZIE

Giorgio

Cerca

Cerca

Script per la somma

pigi

Advanced Member >PLATINUM<

Thauk

Senior Member

pigi

Advanced Member >PLATINUM<

Zetrix

Banned

pigi

Advanced Member >PLATINUM<

Zetrix

Banned

pigi

Advanced Member >PLATINUM<

mastrogino

Advanced Premium Member

pigi

Advanced Member >PLATINUM<

mastrogino

Advanced Premium Member

feli

Member

Zetrix

Banned

mastrogino

Advanced Premium Member

Zetrix

Banned

mastrogino

Advanced Premium Member

pigi

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi