Script per sistemi cruciverba

[fillotto]

scusa fillotto a te funziona?

Ciao Keeper , visto solo adesso ! Confermo a me funziona!!! solo che non mi piacciono i criteri per riempire il cruciverba , che so parlando del lato tre bisogna mettere 9 num allora proporrei di mettere gli 8 terni formati sempre dagli ultimi 9 numeri usciti che però non abbiano dato ambo fra loro quindi come minimo 9 estrazioni .
Senti , approfitto per chiederti se ti ritrovi quel file di excel con l'archivio aggiornante del 10 e lotto ogni 5 minuti a me non si apre più era stato pubblicato su questa sezione

 

[keeper]

te lo invio con email

 

[keeper]

ne ho unoi normale se nmon erro quello aggiornantte era quello di pfca o di chi altro?

 

[keeper]

si chiamava per cado magic numbers
oppure five minutes to win
oppure 10eltoot 5 m ma aggiornalbile manualmente?

 

[fillotto]

si chiamava per cado magic numbers
oppure five minutes to win
oppure 10eltoot 5 m ma aggiornalbile manualmente?

Mi sembra che sia un file di francesco perri , mi ricordo che gli fu domandato come si aggiornava e rispose che si aggiornava automaticamente , successivamente l'autore disse che non intendeva più proseguire

io ho il vecchio file ma se adesso lo vado (al pari di quello tuo) ad aprire mi da il seguente messaggio "Il formato del file che si sta cercando di aprire 'Estrazioni10ELotto5Minuti.xsl' è diverso da quello specificato dall'estrazione del file.Prima di aprire il file , verificare che non sia danneggiato è che provenga da una fonte attendibile. Aprire il file ora? " al che se apro mi favedere il file ma non ci sono più gli aggiornamenti, d'altra parte non vedo come potrebbe perchè non ha macro che va a pescare la fonte di aggiornamento, Luigi, Baffo o altri che ne capiscono potrebbero spiegare ????

 

[keeper]

si credo di averli entrambi ma si aggiornano manualmente te li invio

 

[keeper]

fatto

 

[fillotto]

fatto

Grazie keeper si questi si aggiornano a mano ! forse è una questione di antivirus che blocca qualcosa che non riesco a capire oppure quel file di excel (che è certo ) si aggiornava automaticamente da solo era a tempo , mha!?

 

[LuigiB]

ciao Filotto , la funzione da editare per alimetare i numeri è questa
Purche all'uscita della prrocedura l'array aNumScelti contenga una quantita sufficente di numeri la funzione la puoi pure stravolgere e riscriverla completamente.

Per Keeper .. lo swcript funziona vedi se si è incollato bene o cambia range di anilisi nel programma

Sub AlimentaNumScelti(aNumScelti,idEstr,RuotaDiRil,nLato)

	Dim k,e,n,t
	Dim nNumDaTrov
	
	ReDim aB(90)
	t = 0
	nNumDaTrov = nLato * nLato
		
	For k = idEstr To 1 Step - 1
		For e = 1 To 5
			n = Vert(Estratto(k,RuotaDiRil,e))
			If aB(n) = False Then
				aB(n) = True
				t = t + 1
				If t >= nNumDaTrov Then Exit For
			End If
			
		Next
		If t >= nNumDaTrov Then Exit For
	Next
	
	If t >= nNumDaTrov Then
		ReDim aNumScelti(t)
		t = 0
		For k = 1 To 90
			If aB(k) Then
				t = t + 1
				aNumScelti(t) = k
			End If
		Next
	
	End If
	
End Sub

 

[barattolo]

Ciao LuigiB,

pure a me da lo stesso errore: n =aNumScelti(NumeroCasuale(1,UBound(aNumScelti)))

Mi riferisco a questo script:

Option Explicit 


Dim aNumUsati
Dim aColonne
Dim aNumScelti


Sub Main
    Dim nLato,nScelti
    Const nMinLato = 2
    Const nMaxLato = 12
    ReDim aRuote(1)
    ReDim aPoste(2)
    Dim Sorte,Colpi
    Dim idEstr
    Dim RuotaDiRil
    
    RuotaDiRil = BA_
    aPoste(2) = 1
    aRuote(1) = RuotaDiRil
    Sorte = 2
    Colpi = 1
    nLato = 5
    
    
    nLato = Int(InputBox("Inserire la quantita di numeri per il lato del cruciverba","Lato Cruciverba",nLato))
    If nLato < nMinLato Or nLato > nMaxLato Then
        MsgBox "Il lato dve essere compreso tra " & nMinLato & " e " & nMaxLato
        Exit Sub
    End If
    
    
    ReDim aDiagonali(nLato,nLato)
    Call CalcolaDiagonali(aDiagonali,nLato)
    
    For idEstr = EstrazioneIni To EstrazioneFin Step Colpi
        Call Messaggio("Estrazione " & idEstr)
        ReDim aNumScelti(0)
        Call AlimentaNumScelti(aNumScelti,idEstr,RuotaDiRil,nLato)
        
        Call GiocaCruciverba(aNumScelti,nLato,aDiagonali,aRuote,aPoste,Colpi,Sorte,idEstr)
        
        If ScriptInterrotto Then Exit For
        
    Next
    
    Call ScriviResoconto
    
End Sub
Sub AlimentaNumScelti(aNumScelti,idEstr,RuotaDiRil,nLato)


    Dim k,e,n,t
    Dim nNumDaTrov
    
    ReDim aB(90)
    t = 0
    nNumDaTrov = nLato * nLato
        
    For k = idEstr To 1 Step - 1
        For e = 1 To 5
            n = Vert(Estratto(k,RuotaDiRil,e))
            If aB(n) = False Then
                aB(n) = True
                t = t + 1
                If t >= nNumDaTrov Then Exit For
            End If
            
        Next
        If t >= nNumDaTrov Then Exit For
    Next
    
    If t >= nNumDaTrov Then
        ReDim aNumScelti(t)
        t = 0
        For k = 1 To 90
            If aB(k) Then
                t = t + 1
                aNumScelti(t) = k
            End If
        Next
    
    End If
    
End Sub
Sub GiocaCruciverba(aNumScelti,nLato,aDiagonali,aRuote,aPoste,Colpi,Sorte,idEstr)
    
    Dim r,c,k
    Dim n
    Dim s
    Dim nTentativi
    Dim bTrovato
    Dim nScelti
    Dim bUnaPresenzaSola
    
    Const nTentativiMax = 1000
    bUnaPresenzaSola = False
    
    
    nScelti = UBound(aNumScelti)
    If nScelti >= nLato * nLato Then
        bUnaPresenzaSola = True
    End If
    Call DoEventsEx
    
    aNumUsati = ArrayNumeriToBool(aNumScelti)
    
    Do While bTrovato = False
        ReDim aNumeri(nLato,nLato)
        For r = 1 To nLato
            For c = 1 To nLato
                n = ScegliNumero(r,c,aNumeri,nLato,aDiagonali,bUnaPresenzaSola)
                If n = 0 Then Exit For
                aNumeri(r,c) = n
            Next
            If n = 0 Then Exit For
        Next
        If colonneDuplicate(aNumeri,nLato,aDiagonali) = False Then
            bTrovato = True
        Else
            nTentativi = nTentativi + 1
            If nTentativi > nTentativiMax Then Exit Do
        End If
        If ScriptInterrotto Then Exit Do
        Call Messaggio("Cruciverba Generati " & nTentativi)
        DoEventsEx
    Loop
    For r = 1 To nLato
        ReDim aV(nLato)
        For c = 1 To nLato
            aV(c) = Format2(Int(aNumeri(r,c)))
        Next
        If r = 1 Then
            Call InitTabella(aV,,,6)
        Else
            Call AddRigaTabella(aV,,,6)
        End If
    Next
    If nTentativi > nTentativiMax Or colonneDuplicate(aNumeri,nLato,aDiagonali) Then
        Call Scrivi("ATTENZIONE CRUCIVERBA NON VALIDO",True,,,vbRed)
    
    Else
        Call CreaTabella
        
    End If
    
    For k = 1 To UBound(aColonne)
        ReDim aN(0)
        Call SplitByChar("0." & aColonne(k),".",aN)
        Call ImpostaGiocata(k,aN,aRuote,aPoste,Colpi,Sorte)
    Next
    Call Gioca(idEstr)






    
End Sub




Sub CalcolaDiagonali(aDiagonali,nLato)
    Dim r,c
    For r = 1 To nLato
        c = c + 1
        aDiagonali(r,c) = True
    Next
    c = nLato + 1
    For r = 1 To nLato
        c = c - 1
        If aDiagonali(r,c) Then
            aDiagonali(r,c) = 1
        Else
            aDiagonali(r,c) = True
        End If
    Next
End Sub
Function ScegliNumero(Riga,Colonna,aNumeri,nLato,aDiagonali,bUnaVoltaSola)
    Dim n
    Dim nPassaggi
    Do
        n = aNumScelti(NumeroCasuale(1,UBound(aNumScelti)))
        nPassaggi = nPassaggi + 1
        If nPassaggi > 1000 Then
            n = 0
            Exit Do
        End If
        If ScriptInterrotto Then
            n = 0
            Exit Do
        End If
        Call DoEventsEx
    Loop While NumeroNonValido(n,Riga,Colonna,aNumeri,nLato,aDiagonali,bUnaVoltaSola)
    ScegliNumero = n
End Function
Function NumeroNonValido(Numero,Riga,Colonna,aNumeri,nLato,aDiagonali,bUnaVoltaSola)
    Dim k,r,c
    If Numero = 0 Then
        NumeroNonValido = True
        Exit Function
    End If
    If bUnaVoltaSola Then
        For r = 1 To nLato
            For c = 1 To nLato
                If aNumeri(r,c) = Numero Then
                    NumeroNonValido = True
                    Exit Function
                End If
            Next
        Next
    End If
    If aNumUsati(Numero) = False Then
        NumeroNonValido = True
        Exit Function
    End If
    For k = 1 To nLato
        If aNumeri(Riga,k) = Numero Then
            NumeroNonValido = True
            Exit Function
        End If
    Next
    For k = 1 To nLato
        If aNumeri(k,Colonna) = Numero Then
            NumeroNonValido = True
            Exit Function
        End If
    Next
    If aDiagonali(Riga,Colonna) Then
        'If Riga = Colonna Or ((Riga = nLato/2)And (Colonna = nLato/2)) Then
        If Riga = Colonna Then
            c = Colonna + 1
            For r = Riga To 1 Step - 1
                c = c - 1
                If aNumeri(r,c) = Numero Then
                    NumeroNonValido = True
                    Exit Function
                End If
            Next
            c = Colonna - 1
            For r = Riga + 1 To nLato
                c = c + 1
                If aNumeri(r,c) = Numero Then
                    NumeroNonValido = True
                    Exit Function
                End If
            Next
        End If
        If Riga <> Colonna Or aDiagonali(Riga,Colonna) = 1 Then
            c = Colonna - 1
            For r = Riga To 1 Step - 1
                c = c + 1
                If aNumeri(r,c) = Numero Then
                    NumeroNonValido = True
                    Exit Function
                End If
            Next
            c = Colonna + 1
            For r = Riga + 1 To nLato
                c = c - 1
                If aNumeri(r,c) = Numero Then
                    NumeroNonValido = True
                    Exit Function
                End If
            Next
        End If
    End If
End Function
Function colonneDuplicate(aNumeri,nLato,aDiagonali)
    Dim nColonneTot
    Dim r,c,i
    Dim k,kk
    nColonneTot = nLato * 2 + 2
    ReDim aColonne(nColonneTot)
    For r = 1 To nLato
        ReDim aN(nLato)
        For c = 1 To nLato
            aN(c) = aNumeri(r,c)
        Next
        i = i + 1
        Call OrdinaMatrice(aN,1,1)
        aColonne(i) = StringaNumeri(aN,,True)
    Next
    For c = 1 To nLato
        ReDim aN(nLato)
        For r = 1 To nLato
            aN(r) = aNumeri(r,c)
        Next
        i = i + 1
        Call OrdinaMatrice(aN,1,1)
        aColonne(i) = StringaNumeri(aN,,True)
    Next
    ReDim aN(nLato)
    c = 0
    For r = 1 To nLato
        c = c + 1
        aN(r) = aNumeri(r,c)
    Next
    i = i + 1
    Call OrdinaMatrice(aN,1,1)
    aColonne(i) = StringaNumeri(aN,,True)
    ReDim aN(nLato)
    c = nLato + 1
    For r = 1 To nLato
        c = c - 1
        aN(r) = aNumeri(r,c)
    Next
    i = i + 1
    Call OrdinaMatrice(aN,1,1)
    aColonne(i) = StringaNumeri(aN,,True)
    For k = 1 To nColonneTot - 1
        For kk = k + 1 To nColonneTot
            If aColonne(k) = aColonne(kk) Then
                colonneDuplicate = True
                Exit Function
            End If
        Next
    Next
    For k = 1 To nColonneTot
        If Len(aColonne(k)) < nLato *2 +(nLato - 1) Then
            colonneDuplicate = True
            Exit Function
        End If
    Next
End Function
Function SpezzaStringaNumeri(sStringa)
    Dim k
    Dim s,i
    ReDim aV(0)
    Call SplitByChar(sStringa,".",aV)
    s = ""
    For k = 0 To UBound(aV)
        i = i + 1
        s = s & aV(k) & "."
        If i Mod 20 = 0 Then
            s = s & vbCrLf
        End If
    Next
    SpezzaStringaNumeri = Left(s,Len(s) - 1)
End Function
Function GetNumRealmenteUsati(aNumeri,nLato)
    Dim r,c,k
    Dim s
    ReDim aB(90)
    For r = 1 To nLato
        For c = 1 To nLato
            aB(aNumeri(r,c)) = True
        Next
    Next
    For k = 1 To 90
        If aB(k) Then
            s = s & Format2(k) & "."
        End If
    Next
    If s <> "" Then
        s = Left(s,Len(s) - 1)
    End If
    GetNumRealmenteUsati = s
End Function
Sub ScriviTabellaFreq(aNumeri,nLato)
    Dim r,c,k
    Dim s
    Dim nNumeriPoss
    nNumeriPoss = nLato * nLato
    ReDim aN(90,2)
    For r = 1 To 90
        aN(r,1) = r
    Next
    For r = 1 To nLato
        For c = 1 To nLato
            aN(aNumeri(r,c),2) = aN(aNumeri(r,c),2) + 1
        Next
    Next
    Call OrdinaMatrice(aN,- 1,2)
    ReDim aT(3)
    aT(1) = "Numero"
    aT(2) = "Presenze"
    aT(3) = " % "
    Call InitTabella(aT)
    For k = 1 To 90
        If aN(k,2) > 0 Then
            ReDim aV(3)
            aV(1) = aN(k,1)
            aV(2) = aN(k,2)
            aV(3) = Round((aN(k,2)*100)/nNumeriPoss,3) & " %"
            Call AddRigaTabella(aV)
        End If
    Next
    Call Scrivi("Presenze numeri in gioco nel cruciverba")
    Call CreaTabella
End Sub
Sub SalvaFileColonne
    
    Dim sFile
    Dim k
    
    sFile = GetDirectoryTemp & "Cruciverba.csv"
    If EliminaFile(sFile) Then
        For k = 1 To UBound(aColonne)
            Call ScriviFile(sFile,Replace(aColonne(k),".",";"),,False)
        Next
    
    End If


    Call Scrivi("Le colonne da giocare sono state salvate nel file : " & sFile)
End Sub

 

[keeper]

luigib in basso mi da l'archivio 10elotto5 m ti riferisci a questo vero

 

[LuigiB]

quel'errore che dite capta pure a me ma solo se seleziono un range dove non esistono estrazioni come ad esempio l'inizio archivio
dove Bari non esisteva.
Cambiate range da programma (visto che lo script si basa proprio sul range impostato nel programma) e vedrete che funziona.

 

[barattolo]

quel'errore che dite capta pure a me ma solo se seleziono un range dove non esistono estrazioni come ad esempio l'inizio archivio
dove Bari non esisteva.
Cambiate range da programma (visto che lo script si basa proprio sul range impostato nel programma) e vedrete che funziona.

...sempre il migliore!

Grazie.

 

[Roby]

x Keeper e Filotto

x Keeper e Filotto

ho letto un po di quanto avete scritto in merito ai cruciverba e ai 2 quadrati magici postati da Filotto. (somme 15-12)

ma non ho capito che cosa volete.


vabbe Filotto dice che in caso di un terno di numeri consecutivi, basta prendere il centrale e gli altri 8 numeri suddividerli
per la disposizione quadratica magica.

ma che cosa porta come risultati questo concetto?

all'ambo o al terno?

all'ambo certo, è normale
al terno sarebbe interessante, ma non credo che le disposizioni matematiche dei 9 numeri portano al terno.

qual'è la percentuale che siete a conoscenza dei successi che ne conseguono?


perchè allora non ai quadrati base 30-34-130-260

o numerosissime altre disposizioni?

 

[keeper]

la differenza tra quello di luigi e quello di fillotto è la disposizione dei numeri nel quadrato cioè il numero centrale di una terzina consecuitiva va al centro mentre i numeri facenti parte della novina riempiono il quadrato ma hanno la particolarità che sommati a tre a tre tra loro danno smpre la stessa somma

 

[fillotto]

ho letto un po di quanto avete scritto in merito ai cruciverba e ai 2 quadrati magici postati da Filotto. (somme 15-12)

ma non ho capito che cosa volete.


vabbe Filotto dice che in caso di un terno di numeri consecutivi, basta prendere il centrale e gli altri 8 numeri suddividerli
per la disposizione quadratica magica.

ma che cosa porta come risultati questo concetto?

all'ambo o al terno?

all'ambo certo, è normale
al terno sarebbe interessante, ma non credo che le disposizioni matematiche dei 9 numeri portano al terno.

qual'è la percentuale che siete a conoscenza dei successi che ne conseguono?


perchè allora non ai quadrati base 30-34-130-260

o numerosissime altre disposizioni?

Ciao Rubino e Keeper
"ma che cosa porta come risultati questo concetto?" dovrebbe restringere il campo di osservazione a formazioni omogenee e questo non può essere , nel campo lottologico, che un bene
qual'è la percentuale che siete a conoscenza dei successi che ne conseguono? non lo so tutto quello che posso dire è che si basa da osservazioni empiriche che mi sembrano incoraggianti , per questo si chiedeva il modo di misurare il tutto con uno script....
Il terno a 10 e lotto è tuttaltro che raro ..giocando 8 terni si va avanti x 6 estrazioni senza rimetterci nel lotto è ovviamente + raro ma secondo me vale la pena di indagare
Un modo di procedere (al lotto) potrebbe essere questo : nelle ultime 3 estrazioni di una ruota qualsiasi escono tre numeri consecutivi NON nella stessa estrazione , si metterebbero in gioco gli 8 terni ottenuti con il procedimento suddetto