Sub main()
Dim am(1),n(90),ab(90),a(90),stat(90,1),ru(1),posta(1),poste(2),postee(3)
posta(1)=1 :poste(2)=1
postee(2)=1 :postee(3)=1
ax=CInt(InputBox("Inserisci estrazione iniziale?","Inizio",10275))
ms= CInt(InputBox("Quanti mesi vuoi controllare?","Mesi",7))
k= CInt(InputBox("Quanti colpi vuoi controllare?","Colpi",24))
im= 1 ' INDICE MENSILE
ini=ax
fin=EstrazioneFin
cc=0 : gc=0
For es=ini To fin
ex1=0
If Indicemensile(es) = im Then
ru(1)=3 ' RUOTA DI GIOCO
am(1)=Fuori90(Estratto(es,3,2)+72)' ALGORITMO PER RICERCA AMBATA
ex1=es
ok=0: q=0: ex2=0
For ex2=ex1 To fin
If IsUltimaDelMese (ex2) Then
q=q+1
End If
If q=1 Then ok=1 : rg=ex2-ex1 : Exit For
Next
ex2=es+rg
If ex2=< fin Then
co=0 : Erase n : ee=0
For x=0 To rg-1
sf=SerieFreq (ex1+x,ex1+x,am,ru,1)
If sf>0 Then
ee=ex1+x
For j=1 To 5
nx=Estratto (ee,ru(1),j)
If nx<>am(1) Then co=co+1 :n(co)=nx : stat(nx,1)=stat(nx,1)+1: h=h+1:a(h)=nx
Next
End If
Next
EliminaRipetuti a
ini=es
es=ini
cc=cc+1
If cc=<ms Then
Scrivi
ColoreTesto 2 :Scrivi " ********* Previsione ricavata alla "&(im)&"° estrazione del mese "&_
DataEstrazione (es)& Space (2)& Space (2)&" N° estraz. "&ex2-es& Space (2)& DataEstrazione (ex2)&" *********** ",1
Scrivi"Pronostico n° " & Format2 (cc),1
ColoreTesto 0
Scrivi SiglaRuota (ru(1))& Space (2)& "Ambata "& Space (2)& Format2 (am(1))& Space (2)&"Abbinamenti"& Space (2)& StringaNumeri (n),1
End If
If cc=ms Then
gc=gc+1
Scrivi
Scrivi "Riepilogo Aggregato di ogni Indice Mensile",1
Scrivi StringaNumeri (a),1
g=0: Erase ab
For j=1 To h
If a(j)>0 Then
For i=1 To 90
If a(j)=i And stat(i,1)=>2 Then
g=g+1 : ab(g)=i
Scrivi FormatSpace (ab(g),2,1)& Space (1)&"("&stat(i,1)&")"& Space (2),1,0
End If
Next
End If
Next
Scrivi
Scrivi "------------------------------------------------------------Giocata n°"&gc,1
Scrivi
cc=0
For i=1 To 90
stat(i,1)=0
Next
h=0 : Erase a
End If
End If
End If
Next
Scrivi
Scrivi
ColoreTesto 2 : Scrivi "Forum Ambolotto Listato by Enplein x Fede",1
End Sub
'Funzione creata da Joe
Function IsUltimaDelMese (idEstr)
Dim sData , sDataNew
Dim idGiornoSettimana
Dim gMancanti
Dim nMeseCorr
sData = Replace(DataEstrazione(idEstr) , "." , "/")
nMeseCorr = Month(sData)
idGiornoSettimana = WeekDay (sData)
Select Case idGiornoSettimana
Case vbTuesday ' martedi
gMancanti =2
Case vbThursday ' giovedi
gMancanti = 2
Case vbSaturday ' sabato
gMancanti = 3
End Select
sDataNew = DateAdd( "d" , gMancanti ,sData)
If Month (sDataNew) <> nMeseCorr Then
IsUltimaDelMese = True
Else
IsUltimaDelMese = False
End If
End Function
