Composizione numeri con due casuali

[ikwae]

Ciao a tutti sono ancora a chiedere il vostro aiuto per una macro che è specificata dettagliatamente nei vari passaggi sul foglio allegato.
Brevemente si tratta di una macro che crea due numeri casuali e poi va a cercare in archivio, con criteri specificati, dei numeri da abbinare.

Ringraziando anticipatamente tutti coloro che mi aiuteranno 73 ikwae


http://www.filedropper.com/2018cinqueda ... ciottorete

[Marius44]

Ciao
Vediamo se ho capito ma prima ti consiglio di aggiustare alcune cose:

1°) completa questa parte di codice nelle macro che generano i Testimoni

Codice: Seleziona tutto

While Cells(iRow, 16).Value <> ""  ' colonna 16 la P
iRow = iRow + 1
If iRow > 21 Then GoTo Xit
Wend

e alla fine, prima di settare a Nothing area metti

Codice: Seleziona tutto

Xit:


questo per evitare di scrivere oltre la 21ma riga

Per quanto attiene all'altra macro la butterei giù così:

Codice: Seleziona tutto

Sub Num_Mancanti()
Set area = Range("P4:T20")
For J = 4 To 21
  A = 17
  For I = 1 To 90
    Flag = 0
    For Each c In area
      If c.Value = I Then
        Flag = 1
        Exit For
      End If
    Next
    If Flag = 0 Then
        A = A + 1
        If A > 20 Then Exit For
        Cells(J, A) = I
    End If
  Next I
Next J
Set area = Nothing
End Sub

Non ti sarà sfuggito il fatto che i numeri scritti dalla macro vengono impostati in sequenza, salvo se presenti, dall'1 al 90
Fai sapere. Ciao,
Mario

[ikwae]

Grazie Mario per la risposta ... io ho già quello che suggerisci perché prima che arrivi in fondo ai numeri mancanti c'è una "trappola" che scatta chiamando la tua macro che mi hai fatto te tempo fa e funge una meravigli ... I Testimoni li uso da decenni e fungono a meraviglia comunque, in quelle che uso proverò a modificarle come te proponi. Ho aggiunto le macro dei testimoni e dei numeri mancanti per avere un'unica macro come suggerito nell'allegato. Ho dimenticato di scrivere che l'Archivio ha migliaia di righe e se possibile avere una macro veloce. L'aiuto che cerco è un'unica macro che genera di volta in volta due numeri casuali e poi abbina altri numeri fino a completare le 18 righe ... Ti ringrazio ancora Cordialmente ikwae

[Anthony47]

Non ho trovato nessuna logica in quanto richiesto, per cui penso di aver capito male. Ciononostante propongo questo codice che fa una cosa complicata e analogamente senza logica:

Codice: Seleziona tutto

Dim uArr(1 To 90) As Long, AArr, P4T21(4 To 21, 16 To 20), kArr(1 To 90)
Sub CipNCiop()
Dim Estr0 As String, I As Long, J As Long
Dim myK As String, myTim As Single
'
Sheets("Sviluppo").Select
Estr0 = "G2"
Erase uArr: Erase P4T21: Erase kArr
With Sheets("Archivio")
    AArr = .Range(.Range(Estr0), .Range(Estr0).End(xlDown)).Resize(, 5).Value
End With
Beep
'
myTim = Timer
'Crea indice dei numeri:
For I = 1 To UBound(AArr)
    For J = 1 To UBound(AArr, 2)
        kArr(AArr(I, J)) = kArr(AArr(I, J)) & "-" & I
    Next J
Next I
'
Beep
Randomize
'Raccogli qualcosa in giro:
For I = 4 To 21
    Call GimmeR1R2(I)
    Call GimmeN1N2(I, True)
    Call GimmeN1N2(I, False)
Debug.Print I, Format(Timer - myTim, "0.0")
DoEvents
Next I
'Output risultati:
Range(Cells(LBound(P4T21), LBound(P4T21, 2)), Cells(UBound(P4T21), UBound(P4T21, 2))).Value = P4T21
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.0"))
'   ??? Eventualmente in questa riga Richiama la Sub che riempie i vuoti
End Sub

Sub GimmeR1R2(ByVal II As Long)
Dim LJ As Long, LI As Long, lK As Long
'
For lK = LBound(P4T21, 2) To LBound(P4T21, 2) + 1
    LJ = Int(Rnd() * 90) + 1
    For LI = 1 To 90
        If uArr(LJ) = 0 Then
            P4T21(II, lK) = LJ
            uArr(LJ) = 1
            Exit For
        Else
            LJ = LJ + 1
            If LJ > 90 Then LJ = 1
        End If
    Next LI
Next lK
End Sub

Sub GimmeN1N2(ByVal II As Long, ByVal Fl1 As Boolean)
Dim K1 As String, K2 As String, LI As Long, LJ As Long, Lii As Long
Dim lSplit1, lSplit2, Max1 As Long, Max2 As Long, oLine(1 To 5), CiP As Long
'
If Fl1 Then
    K1 = kArr(P4T21(II, LBound(P4T21, 2)))
    K2 = kArr(P4T21(II, LBound(P4T21, 2) + 1))
Else
    K2 = kArr(P4T21(II, LBound(P4T21, 2)))
    K1 = kArr(P4T21(II, LBound(P4T21, 2) + 1))
End If
'
If Fl1 Then CiP = 0 Else CiP = 2
lSplit1 = Split(K1, "-", , vbTextCompare)
'
'Esamina le righe
For LI = 0 To UBound(lSplit1)
If lSplit1(LI) <> "" Then
    If InStr(1, K2, "-" & lSplit1(LI) & "-", vbTextCompare) = 0 Then
        Lii = CLng(lSplit1(LI))
        For LJ = 1 To 5
            oLine(LJ) = AArr(Lii, LJ)
        Next LJ
        Max1 = Application.WorksheetFunction.Large(oLine, 1)
        Max2 = Application.WorksheetFunction.Large(oLine, 2)
        If (uArr(Max1) = 0 And uArr(Max2) = 0 And Fl1) Or _
           (uArr(Max1) = 0 And Fl1 = False) Then
            P4T21(II, LBound(P4T21, 2) + 2 + CiP) = Max1
            If Fl1 Then P4T21(II, LBound(P4T21, 2) + 3) = Max2
            uArr(Max1) = 1
            If Fl1 Then uArr(Max2) = 1
            Exit For
        End If
    End If
End If
Next LI
End Sub


Va messo tutto RIGOROSAMENTE in un nuovo Modulo vba; poi all'occorrenza si lancia la Sub CipNCiop; non tutte le righe vengono popolate integralmente, ma infatti quanto ho capito non sempre ammette tutte le risposte.

Se devi accodarci un'altra sub (quella che riempe i vuoti?) allora metti una Call a questa sub nella riga marcata ???

Fai sapere...

[ikwae]

Ciao Anthony47 ho letto nel tuo post che non c’è logica ma ti posso assicurare che al momento dei confronti la logica esplode in tutta la sua “bontà” ... ricordiamoci che è solo un hobby .... sono andato a rileggere il tutto ma hai detto “Parole Sante” che non si riesce a capire ma purtroppo sono cose complicate tuttavia hai centrato l’obbiettivo la macro completa le 18 righe ma ci sono dei buchi che non ci devono essere e poi al confronto dei numeri non mi tornano i conti e di conseguenza ho copiato,momentaneamente e, solo per info, le 18 righe sul foglio archivio e con i colori e i numeri in grassetto ho tentato di eliminare eventuali lacune della spiegazione precedente... Penso che una volta capita la procedura sia meno articolata la macro che cerco in aiuto... Se non si riesce a completare le righe arriva pure alla 17 e se ci sono dei buchi cambia i numeri casuali ad inizio riga ma le 17 righe sono importanti oltre che utili per il progetto... Ringraziandoti per il lavoro fatto fin qui e se trovi del tempo e puoi modificare la macro te ne sarei grato. Io non ho fretta fai con calma che come sempre sono molto fiducioso. Allego un file con il solo foglio Archivio ... Cordialmente 73 ikwae

http://www.filedropper.com/2018cinqueda ... iottorete2

[Anthony47]

Sono le condizioni poste che non garantiscono il riempimento di nessuna riga, nemmeno la prima.
Basta pensare che se come numero random viene estratto 88, 89 o 90 non ci sara' nessuna chance di riempire quella riga.
Per aumentare di molto le probabilita' di riempire tutte le righe, spostando comunque il rischio di incompleti alla fine dell'elenco, si puo' limitare la creazione dei random ai numeri <=36. Questo richiede la modifica sia di CipNCiop che di GimmeR1R2, che cambiano come segue:

Codice: Seleziona tutto

Sub CipNCiop()
Dim Estr0 As String, I As Long, J As Long
Dim myK As String, myTim As Single, noH As Boolean
'
Sheets("Sviluppo").Select
Estr0 = "G2"
Erase uArr: Erase P4T21: Erase kArr
With Sheets("Archivio")
    AArr = .Range(.Range(Estr0), .Range(Estr0).End(xlDown)).Resize(, 5).Value
End With
Beep
'
myTim = Timer
'Crea indice dei numeri:
For I = 1 To UBound(AArr)
    For J = 1 To UBound(AArr, 2)
        kArr(AArr(I, J)) = kArr(AArr(I, J)) & "-" & I
    Next J
Next I
'
Beep
Randomize
'Raccogli qualcosa in giro:
'Prima i numeri random
For I = 4 To 21
    Call GimmeR1R2(I)
'    DoEvents
Next I
'Poi i numeri dalle estrazioni
For I = 4 To 21
    Call GimmeN1N2(I, True)
    Call GimmeN1N2(I, False)
    Debug.Print I, Format(Timer - myTim, "0.0")
    DoEvents
Next I

'Output risultati:
Range(Cells(LBound(P4T21), LBound(P4T21, 2)), Cells(UBound(P4T21), UBound(P4T21, 2))).Value = P4T21
MsgBox ("Completato, sec: " & Format(Timer - myTim, "0.0"))
'??? Call Num_Mancanti
End Sub

Sub GimmeR1R2(ByVal II As Long)
Dim LJ As Long, LI As Long, lK As Long, mRnd As Long
'
'Imposta il limite superiore dei numeri random da generare:
mRnd = 36                             '<<< Se si aumenta allora diminuiscono le chances di completare le righe
For lK = LBound(P4T21, 2) To LBound(P4T21, 2) + 1
    LJ = Int(Rnd() * mRnd) + 1
    For LI = 1 To mRnd
        If uArr(LJ) = 0 Then
            P4T21(II, lK) = LJ
            uArr(LJ) = 1
            Exit For
        Else
            LJ = LJ + 1
            If LJ > mRnd Then LJ = 1
        End If
    Next LI
Next lK
End Sub


Rimane invariata la riga delle dichiarazioni iniziali e il codice della Sub GimmeN1N2

Il tutto e' riferito ancora al file con i fogli Archivio e Sviluppo.

Ciao

[Marius44]

Salve a tutti
una domanda da babbeo (visto che non avevo capito nulla circa la richiesta iniziale)

@Anthony perchè dici "se come numero random viene estratto 88, 89 o 90 non ci sara' nessuna chance di riempire quella riga"

Ipotizziamo che sia stato estratto come primo numero l'88; la ricerca mi porta ad una riga che contiene 15 8 21 88 37; secondo quello che è stato detto, prenderò i due maggiori (ovviamente, ritengo, escluso quello che cercavo) quindi 37 e 21.

Questo ragionamento dovrebbe valere anche per la seconda estrazione.
Pertanto non capisco perchè dovrebbero restare celle vuote.

Ciao,
Mario

[ikwae]

Gentilissimi entrambi Anthony e Mario ... quanto onore di avere tutte queste attenzioni... naturalmente un ringraziamento per il tempo che mi dedicate ... vorrei fare un po' di chiarezza Mario ha centrato l'obbiettivo ma le parole di Anthony non sono inesatte perché se ipotizzo che il primo numero casuale sia l'88 posso non avere coppie(quindi anche se uno solo è già presente nelle righe si deve saltare la riga e cercare in giù un altro 88 ma c'è la possibilità che non si trovino più 88 che abbia coppie "libere" e quindi non si riesce a completare la riga ... io ho già affrontato questo problema e ho aumentato l'Archivio a 70 mila righe adesso ne ho messo 100 mila ma non è detto, anche se remota, che si riesce a completare la riga... poi ha trovato un sistema dato l'archivio così lungo e le mie macro, casarecce, sono lentissime ho fatto una trappola che all'errore della macro di Anthony (perché non trovava coppie) "scattava" una macro che cambiava i due numeri iniziali di riga e quindi se non trova l'88 ci sarà un altro numero che è "libero" e girava a cambiare numeri fintanto non si riusciva a completare la riga con questo metodo sono riuscito ad arrivare alla 17à riga e accorciare notevolmente l'archivio... per la 18à non c'è verso di trovare nulla e ho chiesto aiuto a tutto il Forum e il buon Mario mi ha dato questa semplice macro(Sub Num_Mancanti) che ancora oggi uso è una Manna dal Cielo ... tra tanti aiuti ho preferito quella di Mario perché cortissima(guadagno in tempo di esecuzione) e senza formule... Spero di aver chiarito qualche aspetto che era "buio" ... Adesso provo ugualmente la macro di Anthony per il dovuto riscontro... Ringraziandovi entrambi ancora per il vostro aiuto ...Cordialmente 73 ikvae

[Anthony47]

@Anthony perchè dici "se come numero random viene estratto 88, 89 o 90 non ci sara' nessuna chance di riempire quella riga"

Per la regola #2:
upload pictures

Ma se la regola dovesse essere interpretata diversamente da come ho fatto io cambierebbe poco, perche' manchera' sempre la certezza di arrivare fino in fondo, come ha gia' ragionato ikwae.
Con la variante dei numeri random bassi molto spesso si compila anche la riga 18, quasi sempre si compila tutta riga 17, che e' il minimo gradito.
Comunque riempire 18 righe con 5 numeri vuol dire posizionare tutti i 90 numeri: siamo sicuri che ci sia uno schema dove ogni tessera avra' un posto libero da riempire? Ovviamente "No"

Ciao

[ikwae]

Gentilissimo Anthony c'è la possibilità che neanche con un milione di righe di archivio riesci a fare la 18à riga tutte piene per questo ho messo 100 mila righe chiedendo di terminare alla 17à ... Premetto che in un precedente aiuto mi hai fatto una macro che sta funzionando H24 e funge una meraviglia prima lavorava con un archivio con 5 valori e non supera i 25 mila righe e senza "trappola" funge una meraviglia e fa le prese di due numeri alla volta quindi 2+2 per 17 righe poi interviene la macro di Mario per completare la 18à mentre quello che cerco ne deve fare 2+1... contemporaneamente adesso sto lavorando con un'altra tipologia di prese su un archivio di 4 voci ed è lungo meno di 50 mila righe con la medesima presa 2+2 fino alla 17à riga e poi interviene per la 18à la macro di Mario ... detto questo per dire se hai fatto vedere la regola numero 2 vuol dire che probabilmente anzi sicuramente mi sarò spiegato male perché se ho interpretato bene il tuo ultimo post sembra che i numeri devono essere alti ma con l'8 ci poteva anche essere 1 2 3 4 8 e i 2 numeri maggiori il 3 e il 4 che secondo il mio punto di vista penso e ridico che ho spiegato male il tutto ... probabilmente il Mario dice le mi stesse cose ma in un modo diverso da quello che mi sembra di aver intuito... Quindi ricapitolando se riesci ad arrivare fino alla 17à magari senza o con una "forzatura" di completare la riga cambiando i due numeri casuali ad inizio riga oppure non riusciremo mai a capirci scrivendo oppure per capirci l'unica è parlarsi a voce e quindi propongo, se siete disponibili te il Mario e tutto il tuo Team del Forum a mangiare una spaghettata, o altro di vostro gradimento a Milano sui Navigli .... comunque attendo fiducioso una tua soluzione e per quel poco che ti conosco penso che con calma arriverà ... con profonda Stima Cordialmente 73 ikwae

[Anthony47]

Allora...
Ho modificato in modo da ignorare i numeri random dalla ricerca dei "maggiori"; contemporaneamente ho ripristinato il calcolo dei random nel range 1-90.
In questo modo facilmente le righe iniziali si popolano completamente, ma e' molto raro il popolamento completo essendo concentrati i problemi sulle ultime 2-3 righe. Ripetere il ciclo cambia poco.
Avendo notato che e' invece relativamente semplice popolare fino alla riga 18 compresa se i numeri random sono compresi nel range 1-40 ho inserito un "Riprova" se la riga 17 non e' completa ma ho contemporaneamente ridotto a ogni Ripeti l'intervallo dei random di 10.
Ho programmato max 4 ripetizioni,
Durante l'esecuzione, viene selezionata la riga che si sta calcolando (colonna O); se il ciclo viene abortito (riga 17 non completata) allora l'intervallo P4:T21 viene popolato con il risultato che aveva determinato l'abort.
Il ciclo termina appena la riga 17 viene completata completamente, o comunque dopo il quarto retry.

Il codice completo, che sostituisce integralmente il precedente:

Codice: Seleziona tutto

Dim mRnd As Long
Dim uArr(1 To 90) As Long, AArr, P4T21(4 To 21, 16 To 20), kArr(1 To 90), GotIt As Boolean

Sub CipNCiop()
Dim Estr0 As String, I As Long, J As Long
Dim myK As String, myTim As Single, noH As Boolean
Dim noBB As Boolean, tCell As Long, flMax As Long
Dim MaxRetr
'
MaxRetr = 4                     '<<< Il numero max di Retry
mRnd = 90                       'Verra' ridotto a ogni Retry
'
Sheets("Sviluppo").Select
Estr0 = "G2"
Erase uArr: Erase P4T21: Erase kArr
With Sheets("Archivio")
    AArr = .Range(.Range(Estr0), .Range(Estr0).End(xlDown)).Resize(, 5).Value
End With
Beep
'
myTim = Timer
'Crea indice dei numeri:
For I = 1 To UBound(AArr)
    For J = 1 To UBound(AArr, 2)
        kArr(AArr(I, J)) = kArr(AArr(I, J)) & "-" & I
    Next J
Next I
'
Beep
reTry:
Erase uArr: Erase P4T21
Randomize
'Raccogli qualcosa in giro:
'Prima i numeri random
For I = 4 To 21
    Call GimmeR1R2(I)
    DoEvents
Next I
'Poi i numeri dalle estrazioni
For I = 4 To 21
Cells(I, "O").Select
    Call GimmeN1N2(I, True): If GotIt Then tCell = tCell + 4
    Call GimmeN1N2(I, False):: If GotIt Then tCell = tCell + 1
    Debug.Print I, Format(Timer - myTim, "0.0")
    DoEvents
    If tCell < (I - 3) * 5 And I < 21 And flMax < MaxRetr Then
    Debug.Print "#", I, tCell
        flMax = flMax + 1
        noBB = True
        Exit For
    End If
Next I
If noBB Then
    noBB = False
    tCell = 0
    Range(Cells(LBound(P4T21), LBound(P4T21, 2)), Cells(UBound(P4T21), UBound(P4T21, 2))).Value = P4T21
    mRnd = mRnd - 10
    GoTo reTry
End If
'Output risultati:
Range(Cells(LBound(P4T21), LBound(P4T21, 2)), Cells(UBound(P4T21), UBound(P4T21, 2))).Value = P4T21
MsgBox ("Completato; Sec: " & Format(Timer - myTim, "0.0") & ", Retry: " & flMax)
'??? Call Num_Mancanti
End Sub

Sub GimmeR1R2(ByVal II As Long)
Dim LJ As Long, LI As Long, lK As Long
'
'mRnd = 80
For lK = LBound(P4T21, 2) To LBound(P4T21, 2) + 1
    LJ = Int(Rnd() * mRnd) + 1
    For LI = 1 To mRnd
        If uArr(LJ) = 0 Then
            P4T21(II, lK) = LJ
            uArr(LJ) = 1
            Exit For
            If P4T21(II, lK) = "" Then Stop
        Else
            LJ = LJ + 1
            If LJ > mRnd Then LJ = 1
        End If
    Next LI
Next lK
'Stop
End Sub

Sub GimmeN1N2(ByVal II As Long, ByVal Fl1 As Boolean)
Dim K1 As String, K2 As String, LI As Long, LJ As Long, Lii As Long
Dim lSplit1, lSplit2, Max1 As Long, Max2 As Long, oLine(1 To 5), CiP As Long, zZz
'
GotIt = False
If Fl1 Then
    K1 = kArr(P4T21(II, LBound(P4T21, 2)))
    K2 = kArr(P4T21(II, LBound(P4T21, 2) + 1))
Else
    K2 = kArr(P4T21(II, LBound(P4T21, 2)))
    K1 = kArr(P4T21(II, LBound(P4T21, 2) + 1))
End If
'
If Fl1 Then CiP = 0 Else CiP = 2
lSplit1 = Split(K1, "-", , vbTextCompare)
'
'Esamina le righe
For LI = 0 To UBound(lSplit1)
If lSplit1(LI) <> "" Then
    If InStr(1, K2, "-" & lSplit1(LI) & "-", vbTextCompare) = 0 Then
        Lii = CLng(lSplit1(LI))
        For LJ = 1 To 5
            If P4T21(II, LBound(P4T21, 2)) <> AArr(Lii, LJ) And _
              P4T21(II, LBound(P4T21, 2) + 1) <> AArr(Lii, LJ) Then
                oLine(LJ) = AArr(Lii, LJ)
            Else
                oLine(LJ) = 0
            End If
        Next LJ
        Max1 = Application.WorksheetFunction.Large(oLine, 1)
        Max2 = Application.WorksheetFunction.Large(oLine, 2)
'        If Max1 = Max2 Then Stop
        If (uArr(Max1) = 0 And uArr(Max2) = 0 And Fl1) Or _
           (uArr(Max1) = 0 And Fl1 = False) Then
            P4T21(II, LBound(P4T21, 2) + 2 + CiP) = Max1
            If Fl1 Then P4T21(II, LBound(P4T21, 2) + 3) = Max2
            uArr(Max1) = 1
            If Fl1 Then uArr(Max2) = 1
            GotIt = True
            Exit For
        End If
    End If
End If
Next LI
End Sub


Va inserito in un Modulo vba totalmente vuoto.

Ciao

[ikwae]

Gentilissimo Anthony grazie innanzitutto per la tua "Santa Pazienza" e per il lavoro svolto fin qui. Ho letto il listato Capolavoro della macro che hai fatto ma non sono riuscito a capire se le 18 righe si popolano con numeri random oppure con i numeri del mio Archivio che sono delle righe "super qualificate e selezionate" sono state scelte una a una ne avrò due o tre milioni di righe che di volta in volta uso per le prove... intanto provo la macro che hai fatto sperando che prende per popolare le 18 righe i numeri dell'archivio per completare le composizioni ... Ringraziandoti mille e mille volte per il tuo tempo che mi dedichi... Cordialmente 73 ikwae

[ikwae]

Gentilissimo Anthony ... ho provato la tua macro e non so cosa dirti riempie le righe e su 40 lanci, lascia dietro qualche numero della 18à e raramente(uno o due volte) uno o due numeri anche della 17à altro non so ... ma ti posso garantire per certezza che già sta lavorando in un ciclo a fare quello che deve fare e tra una decina di giorni confronto il lavoro che sta facendo con i dati "ufficiali" e ti dirò se va bene o meno per adesso lavora un po' "zoppicante" ma lavora ma del resto per una richiesta, da parte mia, così complessa e già tanto che sta lavorando. Quindi rinnovo i ringraziamenti e buona notte ... Cordialmente ikwae

[Marius44]

Buongiorno a tutti
Stavo rimuginando su questa affermazione di Anthony "Comunque riempire 18 righe con 5 numeri vuol dire posizionare tutti i 90 numeri" quando mi sono visto presentare l'ultima soluzione.

Cosa dire?
Assolutamente geniale. Complimenti.

Ora, rifacendomi sempre all'affermazione di cui sopra, ovviamente le celle vuote sono i numeri mancanti rispetto ai 90 canonici.
Visto che non si riescono a "scovare" perchè non individuare quali sono ed inserirli di forza?

Ho provato con questa macro (che deve essere migliorata e tanto) che mi dà il risultato voluto (almeno credo)

Codice: Seleziona tutto

Sub completa()
Dim area As Range, i As Long, j As Long, manca(1 To 90) As Integer, c As Range, flag As Boolean
Set area = Range("P4:T21")
For i = 1 To 90
  manca(i) = i
Next
For i = 4 To 21
  For j = 16 To 20
    n = Cells(i, j).Value
    For k = 1 To 90
      If n = k Then manca(k) = 0
    Next k
  Next j
Next i
 
For Each c In area
  If c.Value = 0 Then
    For i = 1 To 90
      If manca(i) <> 0 Then
        c.Value = manca(i)
        manca(i) = 0
        Exit For
      End If
    Next i
  End If
Next
End Sub


mentre alla fine di CipNCiop va aggiunta questa riga

Codice: Seleziona tutto

Call completa '??? Call Num_Mancanti


Fai sapere. Ciao,
Mario

[Marius44]

Salve
Avrò fatto quasi 200 prove ed i risultati mi sembrano soddisfacenti.
Solo 3 volte mi si è presentato uno schema con 2 righe (17 e 18) incomplete
Solo 1 volta mi si è presentato uno schema con 3 righe (15, 17 e 18) incomplete
Tutte le altre volte si è presentato uno schema con solo la riga 18 incompleta con talvolta mancanti 2 numeri tal'altra 3 numeri.

Una cosa che mi dà da pensare è che in tutte le prove effettuate i numeri "mancanti" non abbiamo mai superato il 20, cioè le celle vuote vengono riempite con numeri inferiori, mai superiori.

Probabilmente dipende dal modo in cui i numeri vengono randomizzati. Personalmente non sono riuscito ad "entrare" nel codice di Anthony per cercare di capire. In poche parole sarebbe gradita una spiegazione delle due Funzioni Gimme ecc. ecc.

Ciao,
Mario

[Anthony47]

non sono riuscito a capire se le 18 righe si popolano con numeri random oppure con i numeri del mio Archivio

Sono numeri prelevati dalle tue estrazioni.

Una cosa che mi dà da pensare è che in tutte le prove effettuate i numeri "mancanti" non abbiamo mai superato il 20, cioè le celle vuote vengono riempite con numeri inferiori, mai superiori

Avevo gia' constatato e detto che usando come random l'intero range 1-90 la soluzione diventava meno facile, e non ne capivo il motivo... fino a stanotte quando nel dormiveglia ho avuto il lampo...
E' evidente che e' impossibile che numeri quali 1-2-3 vengano pescati dalle estrazioni come i numeri piu' alti; come e' evidente che i numeri man mano che si abbassano hanno sempre meno chances di risultare i piu' alti dell'estrazione. Insomma i numeri bassi o vengono inseriti come numeri random o non hanno chance (1-2-3) o ne hanno da pochissime a poche (4-5.. a crescere). Ecco perche' randomizzando su range piu' limitati le chances di riempire lo schema aumentano, perche' aumenta l'utilizzo di numeri bassi come numeri random.

E ricordo che con la seconda soluzione (vedi viewtopic.php?f=26&t=110039&p=645785#p645755), quella che limitava i random all'intervallo 1-36, lo schema veniva riempito molto spesso per tutte le righe e al 99% fino a riga 17 compresa, senza bisogno di retry.

Mi viene chiesta una spiegazione sul codice; provvedo senza esagerare :
La GimmeR1R2 restituisce due numeri random, prendendoli da quelli non ancora in uso.

La GimmeN1N2 restituisce i due numeri piu' alti di tutte le estrazioni che contengono il Random #1, oppure solo il piu' alto delle estrazioni che contengono Random #2.

In generale nell'array kArr(1 to 90) mi creo all'inizio l'elenco delle righe che contengono ognuno dei 90 numeri; cosi' man mano che esamino i vari random so gia' dove trovo le estrazioni che contengono quel numero.
In uArr(1 To 90) segno i numeri man mano che vengono usati, per evitare che vengano riusati.

Questo mi porta a commentare che se "Num_Mancanti" ha solo l'obiettivo di inserire nello schema i numeri mancanti allora non e' necessario ripartire da zero come deve fare la Sub completa pubblicata da Mario; perche' uArr(1 To 90) gia' conosce quali sono i numeri usati e quali mancano.
Bastera' pertanto inserire questo codice prima di End Sub:

Codice: Seleziona tutto

MsgBox ("Completato; Sec: " & Format(Timer - myTim, "0.0") & ", Retry: " & flMax)
'DA QUI IN AVANTI: Inserisce i numeri mancanti
For I = LBound(P4T21, 1) To UBound(P4T21, 1)
    For J = LBound(P4T21, 2) To UBound(P4T21, 2)
        If P4T21(I, J) = "" Then
            myMatch = Application.Match(0, uArr, False)
            If Not IsError(myMatch) Then
                Cells(I, J) = myMatch
                Cells(I, J).Interior.Color = RGB(255, 200, 200)   'Colora i numeri Inseriti
                uArr(myMatch) = 11
            End If
        End If
    Next J
Next I
End Sub


I numeri aggiunti in questa fase vengono colorati per evidenziarli.

E' pero' anche necessario inserire la dichiarazione della nuova variabile usata e azzerare i colori dell'area risultati: pertanto all'inizio aggiungere queste due righe in questa posizione:

Codice: Seleziona tutto

Dim MaxRetr
Dim myMatch                                  '<<< AGGIUNGERE
Range("P4:T21").Interior.Color = xlNone      '<<< AGGIUNGERE
'
MaxRetr = 4                     '<<< Il numero max di Retry


Ciao

[Marius44]

Salve a tutti

Come sempre: Anthony47 è puntuale e preciso. Grazie.

Funziona a meraviglia. Nel mio post precedente mi ero dimenticato di aggiungere che ho "aumentato" (non volermene, Anthony) la costante MaxRetr a 5 e, molto spesso, non c'è necessità di "coprire i vuoti".

Ciaoa tutti,
Mario

[Anthony47]

Se avevo inserito la riga

Codice: Seleziona tutto

MaxRetr = 4                     '<<< Il numero max di Retry

e' perche' anche io pensavo di poterci "giocare"; tuttavia bisogna ricordare che a ogni Retry il range dei random viene ridotto di 10; quindi 5 e' il massimo che si puo' usare (altrimenti non avremmo almeno 36 random tra cui scegliere).
Piuttosto, ora che sappiamo l'importanza di randomizzare con numeri bassi, io manterrei MaxRetr = 4, ma modificherei subito mRnd = 80.
Volendo possiamo puntare a riempire anche la riga 18 modificando la situazione di retry in

Codice: Seleziona tutto

    If tCell < (I - 3) * 5 And I < 22 And flMax < MaxRetr Then      'INVECE CHE < 21


Ma forse conviene tornare alla soluzione #2, che randomizzava direttamente nel range 1-36 e non aveva bisogno di retry per riempire quasi sempre quasi tutto (vedi viewtopic.php?f=26&t=110039#p645755)

Ciao

[Marius44]

Ciao

ancora una volta hai ragione.
In merito al secondo punto (Ma forse conviene tornare alla soluzione #2, che randomizzava direttamente nel range 1-36 e non aveva bisogno di retry per riempire quasi sempre quasi tutto) bisognerà aspettare il Richiedente che conosce meglio l'obiettivo.

Ciao,
Mario

[ikwae]

Gentilissimi Anthony e Mario ... rinnovo i ringraziamenti per i vostri interventi e tempo che mi dedicate ... ma non penserete mica che ho le conoscenze per rispondervi sul listato della macro? Ieri sera mi sono limitato a leggerla e ho letto, nel listato della macro di Anthony il nome del foglio “Archivio” (l’unica chiara e limpida per me) quindi ho manomesso il nome del foglio e la macro è andata in errore ... Alleluia vuol dire che qualche cosa prende se lo interpella(questo prima dei vostri post).
Detto questo faccio una premessa ... tempo fa io ho fatto delle modifiche alle macro di Anthony, di un precedente aiuto, molto semplici e aggiungo casarecci, che avevano le “prese” di 2+2 fino alla 17à e, modificando la macro di Mario, per leggere i numeri mancanti e con il Trasponi incollavo nell’ultima colonna da T4 a T19 funge a meraviglia ancora oggi... Detto questo per dire che una volta accertato che, la macro di Anthony, prende qualche cosa dal foglio Archivio non ho fatto altro che aggiungere una semplice macro e, aggiungo casareccia, che cancella la 17à e la 18à riga e, con la macro di Mario l’incollo solo 5 numeri per comporre la 17à ... è da stanotte che gira e sta facendo il suo lavoro per sapere i risultati servono almeno 10 giorni ... Quindi leggendo i vostri post e soprattutto la risposta di Anthony sui “numeretti” (1al 9) mi è venuta una “fitta” al cuore perché vuol dire che le righe dalla 1à alla 16à non lavorano a 360° ma alcune possono essere sofferenti,carenti o limitate dai numeretti ... Probabilmente è meglio così sembra che, se non erro, “comandano” i numeri dal 31 al 90 come sortite ma ripeto lo saprò tra 10 giorni circa per adesso lasciamola lavorare ... Una considerazione o domanda ad Anthony “limitare” i numeri di “pesca” da 1 a 36 non è restrittivo rispetto ai 90 numeri? ... Non pensi che con 90 numeri hai più “carne” di scelta nell’archivio? Consideriamo per un momento la mia teoria(che è l’aiuto che cerco) di completare le righe con 90 numeri almeno fino alla 17à come richiesto ... Se si “consumano” 90 numeri per fare 18 righe non c’è lunghezza di archivio e non hai nessun Asso nella manica o (“piano B “) ossia non c’è certezza matematica di completare le 18 righe e se in qualche modo si avvicinano alla semi completezza( come in questo caso) hanno pesanti limitazioni le righe precedenti ... Se invece si considerano sempre i 90 numeri ma per 17 righe, con nessuna limitazione, ecco che ti compare un Asso nella manica o piano B perché hai ancora a disposizione 5 numeri e, su un archivio relativamente lungo, hai 10 coppie o 10 triplette di numeri, che puoi lasciare dietro per poi far “intervenire” la macro di Mario per la Composizione totale.
E’ facile fare teorie ma poi si devono mettere su carta ossia fare delle macro e probabilmente la tua è l’unica soluzione che io ho “acchiappato” al volo e sta lavorando... Adesso provo i vostri suggerimenti dei post e la prossima volta scriverò il giusto e naturale riscontro(aggiungo obbligatorio) ... ancora tanti e tanti ringraziamenti e con Profonda Stima 73 ikwae