| Su richiesta di Claudio Quartine per estratto CODICE 'Script per L8+ (su spaziometria modificare formattazione)
' Quartine per Estratto
Sub Main()
Dim num(4)
Dim ruota(1)
Dim rita(5,16)
Dim max(5,16)
Scrivi
For ep = 1 To 8'scegliere passo
Messaggio ep
H=0
Scrivi "====================================================================================passo " & ep
Scrivi Space(4),0,0
For rr = 1 To 11
If rr = 11 Then rr = 12
Scrivi FormatSpace(SiglaRuota(rr),6),0,0
If rr = 12 Then Scrivi "| quartine "
ruota(1) = rr
eini = EstrazioneFin - 100 'scegliere inizio
efin = EstrazioneFin
c = 0
For p = 1 To 2
For pp = p + 1 To 3
For ppp = pp + 1 To 4
For pppp = ppp + 1 To 5
c = c + 1
For i = eini To efin
num(1) = Estratto(i - ep,rr,p)
num(2) = Estratto(i - ep,rr,pp)
num(3) = Estratto(i - ep,rr,ppp)
num(4) = Estratto(i - ep,rr,pppp)
If SerieFreq(i,i,num,ruota,1) > 0 Then
rita(c,rr) = 0
Else
rita(c,rr) = rita(c,rr) + 1
If max(c,rr) < rita(c,rr) Then max(c,rr) = rita(c,rr)
End If
Next
Next
Next
Next
Next
Next
For z = 1 To 2
For k = z + 1 To 3
For w = k + 1 To 4
For q = w + 1 To 5
h = h + 1
rita(h,13) = Z
rita(h,14) = K
rita(h,15) = W
rita(h,16) = q
max(h,13) = Z
max(h,14) = K
max(h,15) = w
max(h,16) = q
Next
Next
Next
Next
ScriviMatrice rita
'ScriviMatrice max
Erase rita
Erase max
Next
Erase rita
Erase max
End Sub Terzine per estratto CODICE 'Script per L8+ (su spaziometria modificare formattazione)
' Terzine per Estratto
Sub Main()
Dim num(3)
Dim ruota(1)
Dim rita(10,15)
Dim max(10,15)
Scrivi
For ep = 1 To 8'scegliere passo
Messaggio ep
h=0
Scrivi "====================================================================================passo " & ep
Scrivi Space(4),0,0
For rr = 1 To 11
If rr = 11 Then rr = 12
Scrivi FormatSpace(SiglaRuota(rr),6),0,0
If rr = 12 Then Scrivi " terzine"
ruota(1) = rr
eini = EstrazioneFin - 150 'scegliere inizio
efin = EstrazioneFin
c = 0
For p = 1 To 3
For pp = p + 1 To 4
For ppp = pp + 1 To 5
c = c + 1
For i = eini To efin
num(1) = Estratto(i - ep,rr,p)
num(2) = Estratto(i - ep,rr,pp)
num(3) = Estratto(i - ep,rr,ppp)
If SerieFreq(i,i,num,ruota,1) > 0 Then
rita(c,rr) = 0
Else
rita(c,rr) = rita(c,rr) + 1
If max(c,rr) < rita(c,rr) Then max(c,rr) = rita(c,rr)
End If
Next
Next
Next
Next
Next
For z = 1 To 3
For k = z + 1 To 4
For w = k + 1 To 5
h = h + 1
rita(h,13) = Z
rita(h,14) = K
rita(h,15) = W
max(h,13) = Z
max(h,14) = K
max(h,15) = w
Next
Next
Next
ScriviMatrice rita
'ScriviMatrice max
Erase rita
Erase max
Next
Erase rita
Erase max
End Sub Coppie per estratto CODICE 'Script per L8+ (su spaziometria modificare formattazione)
' Coppie per estratto
Sub Main()
Dim num(2)
Dim ruota(1)
Dim rita(10,14)
Dim max(10,14)
Scrivi
For ep = 1 To 8'scegliere passo
Messaggio ep
h=0
Scrivi "=============================================================================passo " & ep
Scrivi Space(4),0,0
For rr = 1 To 11
If rr = 11 Then rr = 12
Scrivi FormatSpace(SiglaRuota(rr),6),0,0
If rr = 12 Then Scrivi " coppie"
ruota(1) = rr
eini = EstrazioneFin - 150 'scegliere inizio
efin = EstrazioneFin
c = 0
For p = 1 To 4
For pp = p + 1 To 5
c = c + 1
For i = eini To efin
num(1) = Estratto(i - ep,rr,p)
num(2) = Estratto(i - ep,rr,pp)
If SerieFreq(i,i,num,ruota,1) > 0 Then
rita(c,rr) = 0
Else
rita(c,rr) = rita(c,rr) + 1
If max(c,rr) < rita(c,rr) Then max(c,rr) = rita(c,rr)
End If
Next
Next
Next
Next
For z = 1 To 4
For k = z + 1 To 5
h = h + 1
rita(h,13) = Z
rita(h,14) = K
max(h,13) = Z
max(h,14) = K
Next
Next
ScriviMatrice rita
'ScriviMatrice max
Erase rita
Erase max
Next
Erase rita
Erase max
End Sub A breve cinquine per estratto Saluti Edited by g.silent - 3/7/2020, 18:47 |
