Numeri Random

[80Sete]

Buona giornata a chi passerà da qui, da poco esperto in materia,
dovrei formare dei cruciverba di 5x5.....7x7 di numeri Random
ma la serie dei numeri dovrei selezionarli io a piacimento,
e soprattutto non devono esserci dei doppi numeri, che siano come nello schema, tutti diversi.
1 - 2 - 3 - 4 - 5
6 - 7 - 8 - 9 - 10
11-12-13-14-15
16-17-18-19-20
21-22-23-24-25

ho creato inoltre una tabella in excel 5x5, con la formula =CASUALE.TRA(1;25)
ma ci sono sempre dei numeri Doppi, chiedo agli esperti, se c'è una formula in excel,
oppure uno script, dove inserisco (a scelta) 25 o 30 numeri,
che formino colonne da 5....da 6....da 7 numeri, dove nello script avrò la possibilità di scegliere
ogni volta quali e quanti numeri, e per quante colonne da ottenere,
tutto questo da utilizzare al Milion.Day-Vinci Casa- o Super Enalotto.
Ringrazio a chi potrà aiutarmi, ed evitare di fare i miei cruciverba a mano.
P.S. Forse, nel forum, esiste già uno script simile.
Ciao

 

[Mike58]

Ciao 80Sete, io ho uno script per vincicasa (ma si può adattare ad altre lotterie) purtroppo ci possono essere numeri ripetuti.
Meglio che niente provalo.
metti almeno 12 numeri per uno schema 5x5

'Option Explicit
Dim aNumUsati
Dim aColonne
Dim aNumScelti
Dim sFile,fin
sFile = GetDirectoryAppData & "Vincicasa.txt" 'allaccia archivio esterno
Call ApriBaseDatiFT(sFile,5,",",40)' tipo di lotteria con q.tà numeri e carattere separatore
Sub Main
   Dim nLato
   Dim r,c,k
   Dim n,es1
   Dim s
   Dim nTentativi
   Dim bTrovato
   Dim nScelti
   Dim bUnaPresenzaSola
   Const nMinLato = 2
   Const nMaxLato = 12
   Const nTentativiMax = 1000
   bUnaPresenzaSola = False
   fin = EstrazioniArchivioFT
   nLato = Int(InputBox("Inserire la quantita di numeri per il lato del cruciverba","Lato Cruciverba",6))
   If nLato < nMinLato Or nLato > nMaxLato Then
      MsgBox "Il lato dve essere compreso tra " & nMinLato & " e " & nMaxLato
      Exit Sub
   End If
   ReDim aNumScelti(0)
   nScelti = ScegliNumeri(aNumScelti)
   If nScelti >= nLato * nLato Then
      bUnaPresenzaSola = True
   End If
   Call DoEventsEx
   If nScelti <= nLato Then
      MsgBox "Selezionare piu numeri",vbInformation
      Exit Sub
   End If
   aNumUsati = ArrayNumeriToBool(aNumScelti)
   ReDim aDiagonali(nLato,nLato)
   Call CalcolaDiagonali(aDiagonali,nLato)
   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)
   End If
   Call Scrivi("Cruciverba " & nLato & "x" & nLato,True)
   Call Scrivi("Si vince con le righe , le colonne e le diagonali")
   Call Scrivi
   Call CreaTabella
   Call Scrivi
   Call Scrivi("Colonne in gioco",True)
   For k = 1 To UBound(aColonne)
      Call Scrivi(FormatSpace(k,5,True) & ") " & aColonne(k) & vbTab & es1)
   Next
   Call Scrivi
   Call Scrivi("Numeri usati",True)
   Call Scrivi(SpezzaStringaNumeri(GetNumRealmenteUsati(aNumeri,nLato)),,True)
   Call Scrivi
   Call ScriviTabellaFreq(aNumeri,nLato)
   Call SalvaFileColonne
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

 

[80Sete]

Grazie Mike58 x la celerità, questo va benissimo, ho fatto delle prove, spesso rilascia numeri doppi (come è logico) ma non è un problema....è capitato un paio di volte che siano tutti diversi, e poi in base a quello che serve....o aggiungo o elimino un numero a colonna. Comunque solo x curiosità....portare lo script a 7 numeri x colonna, è cosa rapida? Da ottobre seguo (saltuariamente) 10 e Lotto Serale, dove ho avuto diverse soddisfazioni giocando 7 nr. Ripeto, se è fattibile....altrimenti ne aggiungo uno a piacimento secondo le mie ricerche. Grazie1000 ancora.
Ciao

 

[Mike58]

Ciao non ho capito il tuo quesito, nello script è possibile stabilire tramite l'input box la lunghezza delle righe e colonne.
anche 10x10 è chiaro avendo una quantità di numeri possibili per la distribuzione del cruciverba.





[URL=https://funkyimg.com/view/3aHzi][/URL]

 

[80Sete]

Cosa dire Mike? imbranataggine da parte mia .....avevo provato prima, ma non mi accettava la modifica.
Ora ho riprovato, vai a capirne la causa.
ecco tutto a posto. Grazie e scusami x l'inconveniente.

Ciao

 

[Mike58]

Bene, infatti non capivo.
Buona indagine e previsione.