Per Luigib

[Y10]

Ciao Luigi , stò monitorando da tempo le prev. di questo tuo Listato , volevo chiederti come mai sulla NZ mi da errore. Gli esisti sono superlativi , grazie se mi risponderai.


Option Explicit
Class clsAmbo
Private aNum(2)
Private aCicli()
Private bUsato
Private QcicliCopertiSeUsato
Private sBit
Property Get Bit
Bit = sBit
End Property
Property Let Usato(b)
bUsato = b
End Property
Property Get Usato
Usato = bUsato
End Property
Property Let QCicli(v)
ReDim aCicli(v)
End Property
Property Get QCicliCopertiSeInUso
QCicliCopertiSeInUso = QcicliCopertiSeUsato
End Property
Property Get QuantitaCicliRapp
Dim k,q
q = 0
For k = 1 To UBound(aCicli)
If aCicli(k) <> 0 Then
q = q + 1
End If
Next
QuantitaCicliRapp = q
End Property
Sub SetFlagCiclo(id,b)
aCicli(id) = b
End Sub
Function GetFlagCiclo(id)
GetFlagCiclo = aCicli(id)
End Function
Sub SetNumero(id,v)
aNum(id) = v
End Sub
Function GetNumeriString
GetNumeriString = StringaNumeri(aNum,,True)
End Function
Sub GetNumeri(aRet)
Dim k
ReDim aRet(UBound(aNum))

For k = 1 To UBound(aNum)
aRet(k) = aNum(k)
Next
End Sub
Sub AggiornaCicliCoperti
Dim k
sBit = ""
QcicliCopertiSeUsato = QuantitaCicliRapp
For k = 1 To UBound(aCicli)
If aCicli(k) <> 0 Then
sBit = sBit & "X"
Else
sBit = sBit & " "
End If
Next

End Sub
End Class
Sub Main
Dim CollAmbi,CollAmbiTrov
Dim Inizio,Fine,nTotNelRange
Dim nLenCiclo,qCicli
Dim idCiclo,k
Dim Ruota
Dim cAmbo
Dim nTrovati

ReDim aRuote(1)
ReDim aPoste(2)


nTrovati = 0
Ruota = ScegliRuota
nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))

aRuote(1) = Ruota
aPoste(2) = 1
Inizio = EstrazioneIni
Fine = EstrazioneFin
nTotNelRange =(Fine + 1) - Inizio
If nTotNelRange Mod nLenCiclo = 0 Then
qCicli = nTotNelRange /nLenCiclo
Else
qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
End If

Call InitCollAmbi(CollAmbi,qCicli)

ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)

Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,CollAmbi)

Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)

Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)








End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
Dim idCiclo,k

Dim cAmbo
nTrovati = 0
ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
Call InitACicli(aCicli,nLenCiclo,Inizio)
Do
For idCiclo = 1 To qCicli
If aCicli(idCiclo,2) = 0 Then
For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
Next
End If
Call AvanzamentoElab(1,qCicli,idCiclo)
If ScriptInterrotto Then Exit Sub
Next
Call GetAmboConPiuCopertura(cAmbo,collAmbi)
If Not cAmbo Is Nothing Then
nTrovati = nTrovati + 1
cAmbo.Usato = True
Call cAmbo.AggiornaCicliCoperti
For idCiclo = 1 To qCicli
If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
aCicli(idCiclo,2) = 1
End If
Next
Else
Exit Do
End If
Call Messaggio("Ambi trovati " & nTrovati)
Call AzzeraCopertura(collAmbi,qCicli)
If ScriptInterrotto Then Exit Sub

Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
Dim idCiclo,k
Dim cAmbo

Call Messaggio("Analisi Giocate")
For idCiclo = 1 To qCicli
k = 0
For Each cAmbo In CollAmbi
If cAmbo.usato Then
k = k + 1
ReDim aNum(0)
Call cAmbo.GetNumeri(aNum)
Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
'Call Scrivi(StringaNumeri(aNum))
End If
Next
Call Gioca(aCicli(idCiclo,0) - 1,True)
Call AvanzamentoElab(1,qCicli,idCiclo)
If ScriptInterrotto Then Exit Sub

Next

Call ScriviResoconto
End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)


Dim cAmbo
Dim idCiclo,k
Dim sTmp
Dim sRigaBit
Call Scrivi("Quadro copertura ambi")



ReDim aT(3 + qCicli)
aT(1) = " N. "
aT(2) = " Ambo "
aT(3) = " Cicli coperti "
For k = 1 To qCicli
aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
Next

Call Messaggio("Creazione tabella copertura")
Call InitTabella(aT)
ReDim aLineeBit(nTrovati)
nTrovati = 0
For Each cAmbo In CollAmbi
If cAmbo.usato Then
nTrovati = nTrovati + 1
aLineeBit(nTrovati) = cAmbo.Bit

ReDim aT(3 + qCicli)
aT(1) = nTrovati
aT(2) = cAmbo.GetNumeriString
aT(3) = cAmbo.QCicliCopertiSeInUso
For k = 1 To qCicli
aT(k + 3) = Mid(cAmbo.Bit,k,1)
Next
ReDim aColoreCelle(UBound(aT))
Call ImpostaArrayColoreCelle(aColoreCelle,aT)
Call AddRigaTabella(aT,aColoreCelle)
End If
If ScriptInterrotto Then Exit Sub

Next



sRigaBit = ""
For idCiclo = 1 To qCicli
sTmp = "-"
For k = 1 To UBound(aLineeBit)
If Mid(aLineeBit(k),idCiclo,1) = "X" Then
sTmp = "X"
Exit For
End If
Next
sRigaBit = sRigaBit & sTmp
Next
'Call Scrivi(Space(20) & sRigaBit)
ReDim aT(3 + qCicli)

For k = 1 To qCicli
aT(k + 3) = Mid(sRigaBit,k,1)

Next
ReDim aColoreCelle(UBound(aT))
Call ImpostaArrayColoreCelle(aColoreCelle,aT)
Call AddRigaTabella(aT,aColoreCelle)
Call CreaTabella

End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,Collambi)
Dim sTmp
Dim cAmbo
Call Scrivi(String(100,"."))

Call Scrivi("Ruota : " & NomeRuota(Ruota))
Call Scrivi("Periodo : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
Call Scrivi("Totale attacchi : " & qCicli)
Call Scrivi
Call Scrivi(Space(20) & "Descrizione del gioco",True)

Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")



Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)

Call Scrivi(String(100,"."))

Call Scrivi()

sTmp = ""
For Each cAmbo In Collambi
If cAmbo.usato Then
sTmp = sTmp &(cAmbo.GetNumeriString) & ","
End If
Next
sTmp = Left(sTmp,Len(sTmp) - 1)
Call Scrivi("Ambi in gioco : " & sTmp)

Call Scrivi(String(100,"."))

Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
Dim k

For k = 1 To UBound(aT)
If aT(k) = "X" Then
aColoreCelle(k) = vbGreen
Else
aColoreCelle(k) = vbWhite
End If
Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)

Dim k
Dim sChr
Dim sTmp

sTmp = FormatSpace(nInizio,4,True)
For k = 1 To 4
sChr = Mid(sTmp,k,1)
Call InsCar(aRighe(k),sChr,idCiclo)

Next

sTmp = FormatSpace(nFine,4,True)
For k = 6 To 9
sChr = Mid(sTmp,k - 5,1)
Call InsCar(aRighe(k),sChr,idCiclo)

Next


End Sub
Sub InsCar(sRiga,sChr,nPos)

Dim sLeft
Dim sRight

sLeft = Left(sRiga,nPos - 1)
sRight = Mid(sRiga,nPos + 1)
sRiga = sLeft & sChr & sRight


End Sub
Function IsScoperto(aCicli,qCicli)
Dim k,b
b = False

For k = 1 To qCicli
If aCicli(k,2) = 0 Then
b = True
Exit For
End If
Next
IsScoperto = b
End Function

Sub AzzeraCopertura(CollAmbi,qCicli)
Dim cAmbo
For Each cAmbo In CollAmbi
cAmbo.qCicli = qCicli
Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
Dim cAmboTmp
Dim nMax,n
nMax = 0
For Each cAmboTmp In CollAmbi
n = cAmboTmp.QuantitaCicliRapp
If n >= nMax Then
nMax = n
Set cAmbo = cAmboTmp
End If
Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
Dim k,kk,s
Dim cAmbo
ReDim aNum(0)


If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
Call OrdinaMatrice(aNum,1)
For k = 1 To 4
For kk = k + 1 To 5
s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
Set cAmbo = CollAmbi(s)
Call cAmbo.SetFlagCiclo(idCiclo,1)
Next
Next
End If
End Sub

Sub InitACicli(aCicli,nLenCiclo,Inizio)
Dim k
Dim nStart
nStart = Inizio
For k = 1 To UBound(aCicli)
aCicli(k,2) = 0
aCicli(k,0) = nStart
aCicli(k,1) =(nStart - 1) + nLenCiclo
nStart = aCicli(k,1) + 1
Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
' sistemi che generano un elevato numero di combinazioni
Dim k,e,s
Dim nClasse
ReDim aNumeri(90)
Dim aColonne
Dim cAmbo
Set CollAmbi = GetNewCollection
nClasse = 2 ' sviluppo in ambi
' inizializzo i numeri da sviluppare in questo caso 90
' ma potrebbero essere anche di meno
For k = 1 To 90
aNumeri(k) = k
Next
' sviluppo il sistema valorizzando le colonne sviluppate
aColonne = SviluppoIntegrale(aNumeri,nClasse)
' scrivo le colonne in output
For k = 1 To UBound(aColonne)
Set cAmbo = New clsAmbo
cAmbo.qCicli = qCicli
s = "k"
' ciclo per leggere la colonna k
For e = 1 To nClasse
Call cAmbo.SetNumero(e,aColonne(k,e))
s = s & Format2(aColonne(k,e)) & "-"
Next
' tolgo l'ultimo trattino
s = Left(s,Len(s) - 1)
Call CollAmbi.Add(cAmbo,s)
Next
End Sub

 

[Y10]

Spero che luigi legga prima possibile , in quanto visti gli esiti vorrei togliere questo script dalla circolazione.

 

[claudio8]

Scusa Mauro, in attesa che Luigi intervenga, vorrei trovarti la riposta, (che già presumo dalla lettura dello script) ma non mi gira per niente, ci sono una serie di "spaziature" strane, potresti ripostarlo in maniera corretta, mi da errori vari. Grazie

 

[mgrruggiu]

Spero che luigi legga prima possibile , in quanto visti gli esiti vorrei togliere questo script dalla circolazione.

Questo scritto lo trovo realmente ridicolo, dopo che Luigi ti fà la correzzione, lo vuoi togliere. Ti appropri anche dei lavori degli altri e poi li togli.
la tua disponibilità verso gli altri non è pari a quanto tu vuoi dagli altri. Vergognoso.

 

[LuigiB]

Nello script non c'è nessun errore , magari prova a farlo girare in un range dove esistono numeri nelle estrazioni della nazionale

un salto a Claudio8 benritorvato

ecco lo script ..tale a quello postato solo che io l'ho incollato in mosdo corretto cosi chi lo vuole usare o usa

Option Explicit
Class clsAmbo
	Private aNum(2)
	Private aCicli()
	Private bUsato
	Private QcicliCopertiSeUsato
	Private sBit
	Property Get Bit
		Bit = sBit
	End Property
	Property Let Usato(b)
		bUsato = b
	End Property
	Property Get Usato
		Usato = bUsato
	End Property
	Property Let QCicli(v)
		ReDim aCicli(v)
	End Property
	Property Get QCicliCopertiSeInUso
		QCicliCopertiSeInUso = QcicliCopertiSeUsato
	End Property
	Property Get QuantitaCicliRapp
		Dim k,q
		q = 0
		For k = 1 To UBound(aCicli)
			If aCicli(k) <> 0 Then
				q = q + 1
			End If
		Next
		QuantitaCicliRapp = q
	End Property
	Sub SetFlagCiclo(id,b)
		aCicli(id) = b
	End Sub
	Function GetFlagCiclo(id)
		GetFlagCiclo = aCicli(id)
	End Function
	Sub SetNumero(id,v)
		aNum(id) = v
	End Sub
	Function GetNumeriString
		GetNumeriString = StringaNumeri(aNum,,True)
	End Function
	Sub GetNumeri(aRet)
		Dim k
		ReDim aRet(UBound(aNum))
		For k = 1 To UBound(aNum)
			aRet(k) = aNum(k)
		Next
	End Sub
	Sub AggiornaCicliCoperti
		Dim k
		sBit = ""
		QcicliCopertiSeUsato = QuantitaCicliRapp
		For k = 1 To UBound(aCicli)
			If aCicli(k) <> 0 Then
				sBit = sBit & "X"
			Else
				sBit = sBit & " "
			End If
		Next
	End Sub
End Class
Sub Main
	Dim CollAmbi,CollAmbiTrov
	Dim Inizio,Fine,nTotNelRange
	Dim nLenCiclo,qCicli
	Dim idCiclo,k
	Dim Ruota
	Dim cAmbo
	Dim nTrovati
	ReDim aRuote(1)
	ReDim aPoste(2)
	nTrovati = 0
	Ruota = ScegliRuota
	nLenCiclo = CInt(InputBox("Colpi di gioco","Colpi","12"))
	aRuote(1) = Ruota
	aPoste(2) = 1
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	nTotNelRange =(Fine + 1) - Inizio
	If nTotNelRange Mod nLenCiclo = 0 Then
		qCicli = nTotNelRange /nLenCiclo
	Else
		qCicli =((nTotNelRange -(nTotNelRange Mod nLenCiclo)) /nLenCiclo) + 1
	End If
	Call InitCollAmbi(CollAmbi,qCicli)
	ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
	Call GestioneRicercaAmbi(qCicli,aCicli,CollAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
	Call GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,CollAmbi)
	Call GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
	Call GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
End Sub
Sub GestioneRicercaAmbi(qCicli,aCicli,collAmbi,nLenCiclo,Inizio,Fine,Ruota,nTrovati)
	Dim idCiclo,k
	Dim cAmbo
	nTrovati = 0
	ReDim aCicli(qCicli,2) ' indice 0 InizioCiclo , Indice 1 Fine Ciclo , Indice 2 <> da 0 se coperto
	Call InitACicli(aCicli,nLenCiclo,Inizio)
	Do
		For idCiclo = 1 To qCicli
			If aCicli(idCiclo,2) = 0 Then
				For k = aCicli(idCiclo,0) To aCicli(idCiclo,1)
					Call AggiornaAmbiUsciti(collAmbi,Ruota,k,idCiclo)
				Next
			End If
			Call AvanzamentoElab(1,qCicli,idCiclo)
			If ScriptInterrotto Then Exit Sub
		Next
		Call GetAmboConPiuCopertura(cAmbo,collAmbi)
		If Not cAmbo Is Nothing Then
			nTrovati = nTrovati + 1
			cAmbo.Usato = True
			Call cAmbo.AggiornaCicliCoperti
			For idCiclo = 1 To qCicli
				If cAmbo.GetFlagCiclo(idCiclo) <> 0 Then
					aCicli(idCiclo,2) = 1
				End If
			Next
		Else
			Exit Do
		End If
		Call Messaggio("Ambi trovati " & nTrovati)
		Call AzzeraCopertura(collAmbi,qCicli)
		If ScriptInterrotto Then Exit Sub
	Loop While IsScoperto(aCicli,qCicli)
End Sub
Sub GestioneAnalisiGiocate(qCicli,aCicli,CollAmbi,aRuote,aPoste,nLenCiclo)
	Dim idCiclo,k
	Dim cAmbo
	Call Messaggio("Analisi Giocate")
	For idCiclo = 1 To qCicli
		k = 0
		For Each cAmbo In CollAmbi
			If cAmbo.usato Then
				k = k + 1
				ReDim aNum(0)
				Call cAmbo.GetNumeri(aNum)
				Call ImpostaGiocata(k,aNum,aRuote,aPoste,nLenCiclo,2,,1)
				'Call Scrivi(StringaNumeri(aNum))
			End If
		Next
		Call Gioca(aCicli(idCiclo,0) - 1,True)
		Call AvanzamentoElab(1,qCicli,idCiclo)
		If ScriptInterrotto Then Exit Sub
	Next
	Call ScriviResoconto
End Sub
Sub GestioneQuadroCopertura(qCicli,aCicli,CollAmbi,nTrovati)
	Dim cAmbo
	Dim idCiclo,k
	Dim sTmp
	Dim sRigaBit
	Call Scrivi("Quadro copertura ambi")
	ReDim aT(3 + qCicli)
	aT(1) = " N. "
	aT(2) = " Ambo "
	aT(3) = " Cicli coperti "
	For k = 1 To qCicli
		aT(k + 3) = aCicli(k,0) & "-" & aCicli(k,1)
	Next
	Call Messaggio("Creazione tabella copertura")
	Call InitTabella(aT)
	ReDim aLineeBit(nTrovati)
	nTrovati = 0
	For Each cAmbo In CollAmbi
		If cAmbo.usato Then
			nTrovati = nTrovati + 1
			aLineeBit(nTrovati) = cAmbo.Bit
			ReDim aT(3 + qCicli)
			aT(1) = nTrovati
			aT(2) = cAmbo.GetNumeriString
			aT(3) = cAmbo.QCicliCopertiSeInUso
			For k = 1 To qCicli
				aT(k + 3) = Mid(cAmbo.Bit,k,1)
			Next
			ReDim aColoreCelle(UBound(aT))
			Call ImpostaArrayColoreCelle(aColoreCelle,aT)
			Call AddRigaTabella(aT,aColoreCelle)
		End If
		If ScriptInterrotto Then Exit Sub
	Next
	sRigaBit = ""
	For idCiclo = 1 To qCicli
		sTmp = "-"
		For k = 1 To UBound(aLineeBit)
			If Mid(aLineeBit(k),idCiclo,1) = "X" Then
				sTmp = "X"
				Exit For
			End If
		Next
		sRigaBit = sRigaBit & sTmp
	Next
	'Call Scrivi(Space(20) & sRigaBit)
	ReDim aT(3 + qCicli)
	For k = 1 To qCicli
		aT(k + 3) = Mid(sRigaBit,k,1)
	Next
	ReDim aColoreCelle(UBound(aT))
	Call ImpostaArrayColoreCelle(aColoreCelle,aT)
	Call AddRigaTabella(aT,aColoreCelle)
	Call CreaTabella
End Sub
Sub GestioneIntstazioneOutput(qCicli,Ruota,Inizio,Fine,nLenCiclo,nTrovati,Collambi)
	Dim sTmp
	Dim cAmbo
	Call Scrivi(String(100,"."))
	Call Scrivi("Ruota : " & NomeRuota(Ruota))
	Call Scrivi("Periodo : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
	Call Scrivi("Colpi per singolo attacco : " & nLenCiclo)
	Call Scrivi("Totale attacchi : " & qCicli)
	Call Scrivi
	Call Scrivi(Space(20) & "Descrizione del gioco",True)
	Call Scrivi("Giocando i seguenti " & nTrovati & " ambi impostando il gioco in " & nLenCiclo & " colpi di gioco")
	Call Scrivi("per ogni attacco e interrompendo alla prima vincita per riprenderlo")
	Call Scrivi("con l'attacco successivo previsto al termine naturale dell'attacco")
	Call Scrivi("in corso si sarebbero ottenuti i seguenti risutati di gioco")
	Call Scrivi("Attenzione non è detto che giocando questa serie di ambi nelle estrazioni",,,,vbRed)
	Call Scrivi("successive a quelle esaminate si otttenga per certo la vincita",,,,vbRed)
	Call Scrivi(String(100,"."))
	Call Scrivi()
	sTmp = ""
	For Each cAmbo In Collambi
		If cAmbo.usato Then
			sTmp = sTmp &(cAmbo.GetNumeriString) & ","
		End If
	Next
	sTmp = Left(sTmp,Len(sTmp) - 1)
	Call Scrivi("Ambi in gioco : " & sTmp)
	Call Scrivi(String(100,"."))
	Call Scrivi()
End Sub
Sub ImpostaArrayColoreCelle(aColoreCelle,aT)
	Dim k
	For k = 1 To UBound(aT)
		If aT(k) = "X" Then
			aColoreCelle(k) = vbGreen
		Else
			aColoreCelle(k) = vbWhite
		End If
	Next
End Sub
Sub AggiornaRigheBuf(aRighe,nInizio,nFine,idCiclo)
	Dim k
	Dim sChr
	Dim sTmp
	sTmp = FormatSpace(nInizio,4,True)
	For k = 1 To 4
		sChr = Mid(sTmp,k,1)
		Call InsCar(aRighe(k),sChr,idCiclo)
	Next
	sTmp = FormatSpace(nFine,4,True)
	For k = 6 To 9
		sChr = Mid(sTmp,k - 5,1)
		Call InsCar(aRighe(k),sChr,idCiclo)
	Next
End Sub
Sub InsCar(sRiga,sChr,nPos)
	Dim sLeft
	Dim sRight
	sLeft = Left(sRiga,nPos - 1)
	sRight = Mid(sRiga,nPos + 1)
	sRiga = sLeft & sChr & sRight
End Sub
Function IsScoperto(aCicli,qCicli)
	Dim k,b
	b = False
	For k = 1 To qCicli
		If aCicli(k,2) = 0 Then
			b = True
			Exit For
		End If
	Next
	IsScoperto = b
End Function
Sub AzzeraCopertura(CollAmbi,qCicli)
	Dim cAmbo
	For Each cAmbo In CollAmbi
		cAmbo.qCicli = qCicli
	Next
End Sub
Sub GetAmboConPiuCopertura(cAmbo,CollAmbi)
	Dim cAmboTmp
	Dim nMax,n
	nMax = 0
	For Each cAmboTmp In CollAmbi
		n = cAmboTmp.QuantitaCicliRapp
		If n >= nMax Then
			nMax = n
			Set cAmbo = cAmboTmp
		End If
	Next
End Sub
Sub AggiornaAmbiUsciti(CollAmbi,Ruota,idEstr,idCiclo)
	Dim k,kk,s
	Dim cAmbo
	ReDim aNum(0)
	If GetArrayNumeriRuota(idEstr,Ruota,aNum) Then
		Call OrdinaMatrice(aNum,1)
		For k = 1 To 4
			For kk = k + 1 To 5
				s = "k" & Format2(aNum(k)) & "-" & Format2(aNum(kk))
				Set cAmbo = CollAmbi(s)
				Call cAmbo.SetFlagCiclo(idCiclo,1)
			Next
		Next
	End If
End Sub
Sub InitACicli(aCicli,nLenCiclo,Inizio)
	Dim k
	Dim nStart
	nStart = Inizio
	For k = 1 To UBound(aCicli)
		aCicli(k,2) = 0
		aCicli(k,0) = nStart
		aCicli(k,1) =(nStart - 1) + nLenCiclo
		nStart = aCicli(k,1) + 1
	Next
End Sub
Sub InitCollAmbi(CollAmbi,qCicli)
	' sistemi che generano un elevato numero di combinazioni
	Dim k,e,s
	Dim nClasse
	ReDim aNumeri(90)
	Dim aColonne
	Dim cAmbo
	Set CollAmbi = GetNewCollection
	nClasse = 2 ' sviluppo in ambi
	' inizializzo i numeri da sviluppare in questo caso 90
	' ma potrebbero essere anche di meno
	For k = 1 To 90
		aNumeri(k) = k
	Next
	' sviluppo il sistema valorizzando le colonne sviluppate
	aColonne = SviluppoIntegrale(aNumeri,nClasse)
	' scrivo le colonne in output
	For k = 1 To UBound(aColonne)
		Set cAmbo = New clsAmbo
		cAmbo.qCicli = qCicli
		s = "k"
		' ciclo per leggere la colonna k
		For e = 1 To nClasse
			Call cAmbo.SetNumero(e,aColonne(k,e))
			s = s & Format2(aColonne(k,e)) & "-"
		Next
		' tolgo l'ultimo trattino
		s = Left(s,Len(s) - 1)
		Call CollAmbi.Add(cAmbo,s)
	Next
End Sub

 

[claudio8]

Grazie del saluto Luigi, spero che la mia non sia solo una visitina temporanea.
Quanto hai detto era ciò che avevo intuito leggendo lo script, (il range di estrazioni x la nazionale per altre ruote non può superare il numero di estrazioni in cui esistono i numeri), ma volevo attendere la risposta di Y10 perchè trovavo strano che nel copiare lo script, si fossero formate delle "spaziature".
Ancora un saluto e ringraziamento per il tuo lavoro.... ho letto di Moro80 .. (ottimo risultato per il Plugin) ed ho riso tantissimo ricordando le bacchettate ricevute....

 

[LuigiB]

ahahah .. io me ne ero scordato .. ciao

 

[arcor]

ciao luigi a me il tuo script mi da errore che posto

 

[Y10]

Questo scritto lo trovo realmente ridicolo, dopo che Luigi ti fà la correzzione, lo vuoi togliere. Ti appropri anche dei lavori degli altri e poi li togli.
la tua disponibilità verso gli altri non è pari a quanto tu vuoi dagli altri. Vergognoso.

Cia carissimo , non capisco questo tuo scatto d'ira , il mio intento di volerlo togliere era per il semplice motivo che certi ottimi lavori , quando iniziano a girare troppo smettono di dare , non centra nulla l'altruismo , se fossi stato egoista l'avrei inviato a Luigi in pvt. Quindi , invece di perdere tempo a cazz...iare potevi già averne fatto il copia/incolla. Argomento chiuso.

 

[Y10]

Grazie mille a Luigib e Cladio8 per l'interessamento .

 

[claudio8]

ciao luigi a me il tuo script mi da errore che posto

Vedi l'allegato 12794

devi stringere il range delle estrazioni su spaziometria Periodo iniziale : [04720] [ 24] 17.06.1961 x tuttele ruote.
Per la nazionale devi usare come inizio la estrazione fine-1444

opure sostituisi nello script questo :
Inizio = EstrazioneIni

con

Inizio = EstrazioneFin-1445 '( per la nazionale ) oppure 4166 per le tutte le altre ruote; questi valori aumenteranno man mano che vi saranno in archivio lotto altre estrazioni

Ps: io ho solo testato bari.

Buone prove... per me ci sono troppi ambi da mettere in gioco occorre selezionarli

 

[Y10]

Ciao Claudio , per avere meno ambi , basta che abbassi il range estrazioni , (se lo imposti a 500 hai meno ambi ma naturalmente anche meno casi giocabili) il problema che pur variando il range , non ho ancora trovato un caso con giocata in corso onde poter verificare

 

[Y10]

Per correttezza , un'altra cosa , questo script è stato fatto da Luigi che lo citava "da una idea di Vecchione Antonio" quindi merito e lode ad entrambi.

 

[claudio8]

ciao luigi a me il tuo script mi da errore che posto

Vedi l'allegato 12794

tra "aPoste(2) = 1 e

Fine = EstrazioneFin "

" sostituire con questo pezzo di script e tutto va in automatico.

If Ruota = 12 Then
Inizio = 7441
Else
Inizio = 4720
End If


spero di non aver sbagliato le estrazioni iniziali valide dopo le quali non ci sono estrazioni vuote, io ho provato la ruota di bari, a vio la verifica delle altre.

 

[claudio8]

Ciao Claudio , per avere meno ambi , basta che abbassi il range estrazioni , (se lo imposti a 500 hai meno ambi ma naturalmente anche meno casi giocabili) il problema che pur variando il range , non ho ancora trovato un caso con giocata in corso onde poter verificare

non ho approfondito lo script nei dettagli, ma se mi spieghi un tantino il processo e specificatamente i "cicli" potrei provare a migliorarlo x "andare a Cassa" sempre se possibile

Se invece hai tra le mani il link della spiegazione di Vecchione, forse riesco a capire altre cose. Grazie.

 

[Y10]

Ciao , il Link di Vecchione proprio non lo ritrovo , ci potrebbe essere di aiuto Luigib.

 

[arcor]

Grazie claudio8 or a funziona perfettamente
ciao

 

[giuseppe56]

Buon ferragosto a tutti

il link è questo sperando di fare cosa gradita

Cerco help dal mitico luigi b.mht!http://forum.lottoced.com/f12/cerco-help-dal-mitico-luigi-b-99362/

Cordialmente Giuseppe

 

[Y10]

Mille grazie giuseppe.

 

[claudio8]

Sono spiacente dovervi dire che la richiesta di Vecchione verteva sull'utilizzo delle spie presenti nelle 3 estrazioni antecedenti quella del gioco per selezionare quelli giocabili, mentre lo script di Luigi ricerca analizzando i vari cicli, gli ambi che giocati contemporaneamente per tutti i cicli (durata ciclo = colpi di gioco) soddisfano la condizione "almeno uno che dia esito" entro i colpi specificati.
Vado ad approfondire per valutare il percorso per la "cassa".... a stima, ritengo che si debbano ridurre drasticamente il numero dei cicli. La mia esperienza in genere mi dice che un metodo ha sempre breve durata. Oltre non posso dirvi.