solare
Advanced Member >PLATINUM<
Ciao Joe91, questo è un listato che gentilmente hai modificato x me e gli amici del forum.
Vorrei chiederti se è possibile adattarlo per il lotto UK 49.
Grazie
'Ricerca SemiCiclica By Joe Rev. 3.0 del 9/7/2014(su script di LuigiB ?).
' la sortita teorica di un numero è di circa 4.5 estrazioni
Option Explicit
Sub Main
Dim TipoArc
Dim nCicli
Dim Inizio,Fine
Dim idEstr
Dim idDecina
Dim sErr
Dim nTotale
Dim nTotale2
Dim nTotale3
Dim nTotale4
Dim CL,CL1,CL2
ReDim aNum(10)
ReDim aRuote(1)
CL1 = 3 : CL1 = CInt(InputBox("Esempio: " & CL1 & " Estrazioni.","PRIMO SEMICICLO",CL1))
CL2 = 3 : CL2 = CInt(InputBox("Esempio: " & CL2 & " Estrazioni.","SECONDO SEMICICLO",CL2))
CL = CL1 + CL2 'Ciclo Completo
nCicli = 5 : nCicli = CInt(InputBox("Esempio: " & nCicli,"NUMERO DI CICLI (di " & CL & " estrazioni).",5))
TipoArc = ScegliArchivio
Call ImpostaArchivio10ELotto(TipoArc)
Inizio =(EstrazioniArchivioDL -(nCicli * CL)) + 1
Fine = EstrazioniArchivioDL - CL + 1
If nCicli > 0 And Inizio > 0 And TipoArc > 0 Then
For idDecina = 1 To 9
nTotale = 0
Call AlimentaNumeri(idDecina,aNum)
ReDim aTitoli(5)
aTitoli(1) = " Range (" & CL1 & "+" & CL2 & ") Estrazioni."
aTitoli(2) = " Primo Semic"
aTitoli(3) = " Secondo Semic "
aTitoli(4) = " Totali Ciclo "
aTitoli(5) = " Ultimo Diff tra 1° e 2 ciclo "
Call InitTabella(aTitoli)
For idEstr = Inizio To Fine Step CL
ReDim aValori(5)
aValori(1) = CStr(idEstr) & "-" & CStr(idEstr + CL1 - 1) & " + " & CStr(idEstr) + CL1 & "-" & CStr(idEstr + CL - 1)
aValori(2) = SerieFreqDL(idEstr,idEstr + CL1 - 1,aNum,1)
aValori(3) = SerieFreqDL(idEstr + CL1,idEstr + CL - 1,aNum,1)
aValori(4) = aValori(2) + aValori(3)
aValori(5) = aValori(3) - aValori(2)
nTotale = nTotale + aValori(5)
nTotale2 = nTotale2 + CLng(aValori(2))
nTotale3 = nTotale3 + CLng(aValori(3))
nTotale4 = nTotale4 + CLng(aValori(4))
Call AddRigaTabella(aValori)
Next
ReDim aValori(5)
aValori(1) = "T O T A L I"
aValori(2) = nTotale2
aValori(3) = nTotale3
aValori(4) = nTotale4
aValori(5) = nTotale
Call AddRigaTabella(aValori,vbYellow)
nTotale2 = 0
nTotale3 = 0
nTotale4 = 0
Call Scrivi("Pres in Dec : " & StringaNumeri(aNum,,True),True)
Call Scrivi
Call CreaTabella
Next
Else
If nCicli <= 0 Then
sErr = "Numero di cicli non valido"
End If
If Inizio <= 0 Then
sErr = "Troppi cicli rispetto alle estrazioni del range"
End If
If idDecina <= 0 Then
sErr = "Nessuna decina selezionata"
End If
If TipoArc <= 0 Then
sErr = "Specificare quale archivio 10 e lotto"
End If
MsgBox sErr,vbCritical
End If
End Sub
Function ScegliDecina()
ReDim aVoci(8)
Dim k,i
For k = 1 To 81 Step 10
aVoci(i) = "Decina " & k & " - " & k + 9
i = i + 1
Next
ScegliDecina = ScegliOpzioneMenu(aVoci,0,"Selezione decina") + 1
End Function
Sub AlimentaNumeri(idDecina,aNum)
Dim i,k,y
i =((idDecina - 1) * 10) + 1
For k = i To(i - 1) + 10
y = y + 1
aNum
= k
Next
End Sub
Function ScegliArchivio()
ReDim aVoci(1)
aVoci(0) = "Dieci e lotto"
aVoci(1) = "Dieci e lotto 5 min"
ScegliArchivio = ScegliOpzioneMenu(aVoci,0,"Selezione archivio") + 1
End Function
Vorrei chiederti se è possibile adattarlo per il lotto UK 49.
Grazie
'Ricerca SemiCiclica By Joe Rev. 3.0 del 9/7/2014(su script di LuigiB ?).
' la sortita teorica di un numero è di circa 4.5 estrazioni
Option Explicit
Sub Main
Dim TipoArc
Dim nCicli
Dim Inizio,Fine
Dim idEstr
Dim idDecina
Dim sErr
Dim nTotale
Dim nTotale2
Dim nTotale3
Dim nTotale4
Dim CL,CL1,CL2
ReDim aNum(10)
ReDim aRuote(1)
CL1 = 3 : CL1 = CInt(InputBox("Esempio: " & CL1 & " Estrazioni.","PRIMO SEMICICLO",CL1))
CL2 = 3 : CL2 = CInt(InputBox("Esempio: " & CL2 & " Estrazioni.","SECONDO SEMICICLO",CL2))
CL = CL1 + CL2 'Ciclo Completo
nCicli = 5 : nCicli = CInt(InputBox("Esempio: " & nCicli,"NUMERO DI CICLI (di " & CL & " estrazioni).",5))
TipoArc = ScegliArchivio
Call ImpostaArchivio10ELotto(TipoArc)
Inizio =(EstrazioniArchivioDL -(nCicli * CL)) + 1
Fine = EstrazioniArchivioDL - CL + 1
If nCicli > 0 And Inizio > 0 And TipoArc > 0 Then
For idDecina = 1 To 9
nTotale = 0
Call AlimentaNumeri(idDecina,aNum)
ReDim aTitoli(5)
aTitoli(1) = " Range (" & CL1 & "+" & CL2 & ") Estrazioni."
aTitoli(2) = " Primo Semic"
aTitoli(3) = " Secondo Semic "
aTitoli(4) = " Totali Ciclo "
aTitoli(5) = " Ultimo Diff tra 1° e 2 ciclo "
Call InitTabella(aTitoli)
For idEstr = Inizio To Fine Step CL
ReDim aValori(5)
aValori(1) = CStr(idEstr) & "-" & CStr(idEstr + CL1 - 1) & " + " & CStr(idEstr) + CL1 & "-" & CStr(idEstr + CL - 1)
aValori(2) = SerieFreqDL(idEstr,idEstr + CL1 - 1,aNum,1)
aValori(3) = SerieFreqDL(idEstr + CL1,idEstr + CL - 1,aNum,1)
aValori(4) = aValori(2) + aValori(3)
aValori(5) = aValori(3) - aValori(2)
nTotale = nTotale + aValori(5)
nTotale2 = nTotale2 + CLng(aValori(2))
nTotale3 = nTotale3 + CLng(aValori(3))
nTotale4 = nTotale4 + CLng(aValori(4))
Call AddRigaTabella(aValori)
Next
ReDim aValori(5)
aValori(1) = "T O T A L I"
aValori(2) = nTotale2
aValori(3) = nTotale3
aValori(4) = nTotale4
aValori(5) = nTotale
Call AddRigaTabella(aValori,vbYellow)
nTotale2 = 0
nTotale3 = 0
nTotale4 = 0
Call Scrivi("Pres in Dec : " & StringaNumeri(aNum,,True),True)
Call Scrivi
Call CreaTabella
Next
Else
If nCicli <= 0 Then
sErr = "Numero di cicli non valido"
End If
If Inizio <= 0 Then
sErr = "Troppi cicli rispetto alle estrazioni del range"
End If
If idDecina <= 0 Then
sErr = "Nessuna decina selezionata"
End If
If TipoArc <= 0 Then
sErr = "Specificare quale archivio 10 e lotto"
End If
MsgBox sErr,vbCritical
End If
End Sub
Function ScegliDecina()
ReDim aVoci(8)
Dim k,i
For k = 1 To 81 Step 10
aVoci(i) = "Decina " & k & " - " & k + 9
i = i + 1
Next
ScegliDecina = ScegliOpzioneMenu(aVoci,0,"Selezione decina") + 1
End Function
Sub AlimentaNumeri(idDecina,aNum)
Dim i,k,y
i =((idDecina - 1) * 10) + 1
For k = i To(i - 1) + 10
y = y + 1
aNum
= kNext
End Sub
Function ScegliArchivio()
ReDim aVoci(1)
aVoci(0) = "Dieci e lotto"
aVoci(1) = "Dieci e lotto 5 min"
ScegliArchivio = ScegliOpzioneMenu(aVoci,0,"Selezione archivio") + 1
End Function
