Storico RDL ultimo estratto di 3 CSI, Aggiunto calcolo Storici e Attuali con output su file di testo

Dim FileOut
Sub main()
Call CreaFile("c:\test.txt") '---> Leggi qui sotto:

'Se viene rinominato il file, oppure cambiata la path di destinazione, ricordarsi di aggiornare anche la penultima
'riga prima dell'End Sub, ovvero "CreateObjec...."

Dim a1(1),a2(1),a3(1),a4(1), a5(1),aa1(1),aa2(1),aa3(1), aa4(1),aa5(1),aaa1(1),aaa2(1),aaa3(1), aaa4(1),aaa5(1)
Dim sp(5),sp1(5),sp2(5),sp3(5),ru(1),ru1(1),ru2(1),bbb(3),bb(1),bb1(1),bb2(1)

Fileout.writeline "Storico RSIL 5° numero dopo la sortita contemporanea del 4° estratto di 3 CSI (Cinzia --> Modificato da Gam - 26.07.2011)"
fileout.writeline

ini=EstrazioneFin-100'EstrazioneIni
fin=EstrazioneFin

For es=ini To fin

For r=1 To 9
ru(1)=r
For r1=r+1 To 10
ru1(1)=r1
For r2=r1+1 To 11
If r2=11 Then r2=12
ru2(1)=r2

Messaggio("Elaborazione: " & es& " --> Ruote --> " & Format2(r) & "-" & Format2(r1)& "-" & Format2(r2))

a1(1)=Estratto(es,r,1)
If a1(1)>0 Then
a2(1)=Estratto(es,r,2)
a3(1)=Estratto(es,r,3)
a4(1)=Estratto(es,r,4)
a5(1)=Estratto(es,r,5)
aa1(1)=Estratto(es,r1,1)
If aa1(1)>0 Then
aa2(1)=Estratto(es,r1,2)
aa3(1)=Estratto(es,r1,3)
aa4(1)=Estratto(es,r1,4)
aa5(1)=Estratto(es,r1,5)
aaa1(1)=Estratto(es,r2,1)
If aaa1(1)>0 Then
aaa2(1)=Estratto(es,r2,2)
aaa3(1)=Estratto(es,r2,3)
aaa4(1)=Estratto(es,r2,4)
aaa5(1)=Estratto(es,r2,5)
sp(1)=SeriePrima(es+1,EstrazioneFin,a1,ru,1)
sp(2)=SeriePrima(es+1,EstrazioneFin,a2,ru,1)
sp(3)=SeriePrima(es+1,EstrazioneFin,a3,ru,1)
sp(4)=SeriePrima(es+1,EstrazioneFin,a4,ru,1)
sp(5)=SeriePrima(es+1,EstrazioneFin,a5,ru,1)
sp1(1)=SeriePrima(es+1,EstrazioneFin,aa1,ru1,1)
sp1(2)=SeriePrima(es+1,EstrazioneFin,aa2,ru1,1)
sp1(3)=SeriePrima(es+1,EstrazioneFin,aa3,ru1,1)
sp1(4)=SeriePrima(es+1,EstrazioneFin,aa4,ru1,1)
sp1(5)=SeriePrima(es+1,EstrazioneFin,aa5,ru1,1)
sp2(1)=SeriePrima(es+1,EstrazioneFin,aaa1,ru2,1)
sp2(2)=SeriePrima(es+1,EstrazioneFin,aaa2,ru2,1)
sp2(3)=SeriePrima(es+1,EstrazioneFin,aaa3,ru2,1)
sp2(4)=SeriePrima(es+1,EstrazioneFin,aaa4,ru2,1)
sp2(5)=SeriePrima(es+1,EstrazioneFin,aaa5,ru2,1)
OrdinaMatrice sp
OrdinaMatrice sp1
OrdinaMatrice sp2

If sp(1)>0 And sp1(1)>0 And sp2(1)>0 And _
sp(4)<sp(5) And sp1(4)<sp1(5)And sp2(4)<sp2(5) Then
If sp(4)=sp1(4)And sp(4)=sp2(4) Then

bbb(1)=sp(5)
bbb(2)=sp1(5)
bbb(3)=sp2(5)
OrdinaMatrice bbb
ss=bbb(1)
rsil=ss-sp(4)
y=""
FileOut.Write Formattanumero(es,4)&" "& Formattanumero(sp(4),4)&" "& SiglaRuota(r)&" " &SiglaRuota(r1)&" "&SiglaRuota(r2)& " " &Formattanumero(ss,4)

For pp=1 To 5
bb(1)=Estratto(es,r,pp)
If SerieFreq(es+1,ss-1,bb,ru,1)=0 And SerieFreq(ss,ss,bb,ru,1)>0 Then
y= " "&SiglaRuota(r)&" "&formattanumero(bb(1),2)
End If
Next

For pp1=1 To 5
bb1(1)=Estratto(es,r1,pp1)
If SerieFreq(es+1,ss-1,bb1,ru1,1)=0 And SerieFreq(ss,ss,bb1,ru1,1)>0 Then
y=y&" " &SiglaRuota(r1)&" "&formattanumero(bb1(1),2)
End If
Next

For pp2=1 To 5
bb2(1)=Estratto(es,r2,pp2)
If SerieFreq(es+1,ss-1,bb2,ru2,1)=0 And SerieFreq(ss,ss,bb2,ru2,1)>0 Then
y=y&" "& SiglaRuota(r2)&" "&formattanumero(bb2(1),2)
End If
Next
l=0
l=Len(y)
If l=6 Then fileout.writeline y & Space(12) & " STO "& formattanumero(ss-es,4) &" RDL "& formattanumero(rsil,4)
If l=12 Then fileout.writeline y & Space(6) & " STO "& formattanumero(ss-es,4) &" RDL "& formattanumero(rsil,4)
If l=18 Then fileout.writeline y & " STO "& formattanumero(ss-es,4) &" RDL "& formattanumero(rsil,4)


End If
End If
If sp(1)=0 And sp1(1)=0 And sp2(1)=0 And sp(2)>0 And sp1(2)>0 And sp2(2)>0 And _
sp(2)<sp(3) And sp1(2)<sp1(3)And sp2(2)<sp2(3)Then

If sp(5)=sp1(5)And sp(5)=sp2(5) Then

bbb(1)=estrazionefin'sp(5)
bbb(2)=sp1(5)
bbb(3)=sp2(5)
OrdinaMatrice bbb
ss=estrazionefin'bbb(1)
rsil=EstrazioneFin-sp(5)

FileOut.Write Formattanumero(es,4)&" "& Formattanumero(sp(4),4)&" "& SiglaRuota(r)&" " &SiglaRuota(r1)&" "&SiglaRuota(r2)& " "

For pp=1 To 5
bb(1)=Estratto(es,r,pp)
ratt=SeriePrima(es+1,EstrazioneFin ,bb,ru,1)
If ratt=0 Then
x= Formattanumero(ss,4)&" "&SiglaRuota(r)&" "&formattanumero(bb(1),2) & " "
End If
Next

For pp1=1 To 5
bb1(1)=Estratto(es,r1,pp1)
ratt=SeriePrima(es+1,EstrazioneFin ,bb1,ru1,1)
If ratt=0 Then
x=x& SiglaRuota(r1)&" "&formattanumero(bb1(1),2)& " "
End If
Next

For pp2=1 To 5

bb2(1)=Estratto(es,r2,pp2)
ratt=SeriePrima(es+1,EstrazioneFin ,bb2,ru2,1)
If ratt=0 Then
x=x& SiglaRuota(r2)&" "&formattanumero(bb2(1),2)&" ATT "& formattanumero(ss-es,4) &" RDL "& formattanumero(rsil,4)
End If
Next
fileout.writeline x & " ***"

End If
End If
End If
End If
End If
Next
Next
Next
Next

fileout.close
MsgBox "Fine Elaborazione"
CreateObject("WScript.Shell").Run "notepad.exe c:\test.txt" ' aggiornare anche qui in caso di cambio nome
End Sub


Sub CreaFile(NomefileOut)
Dim OggFile, fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateTextFile (NomefileOut)
Set OggFile = fso.GetFile(NomefileOut)
Set FileOut = OggFile.OpenAsTextStream(2)
End Sub

Function FormattaNumero(numero, formato)
Dim numero1
Select Case formato
Case 2
If numero < 10 Then
numero1 = "0" + LTrim(CStr(numero))
Else
numero1 = LTrim(CStr(numero))
End If
FormattaNumero= numero1
Case 3
If numero < 10 Then
numero1 = "00" + LTrim(CStr(numero))
Else
If numero < 100 Then
numero1 = "0" + LTrim(CStr(numero))
Else
numero1 = LTrim(CStr(numero))
End If
End If
FormattaNumero= numero1
Case 4
If numero < 10 Then
numero1 = "000" + LTrim(CStr(numero))
End If
If numero > 9 And numero < 100 Then
numero1 = "00" + LTrim(CStr(numero))
End If
If numero > 99 And numero < 1000 Then
numero1 = "0" + LTrim(CStr(numero))
End If
If numero > 999 Then numero1 = LTrim(CStr(numero))
FormattaNumero= numero1
End Select
End Function