Calcolo 4005 ambi

[Statix]

Ciao a tutti,
volevo chiedere se c'è una possibiltà di ridurre i tempi di elaborazione,
penso che questo quesito interessa moltissimo agli appassionati del lotto,
infatti nel forum ci sono diversi post al riguardo , ma personalizzati ,
quello che propongo è molto semplice ,
prendiamo un archivio tipo 10elotto5 minuti,
sono 20 estratti per ogni 5 minuti,
in un giorno si hanno 288 estrazioni di 20 numeri, volendo calcolare tutti i ritardi,frequenza e max storico,
uso questa macro che impiega circa 6 minuti con un computer di nuova generazione 9 uno di vecchia generazione.
quindi chiedo se è possibile ridurre ulteriormente l'elaborazione con una nuova macro,
grazie.

Codice: Seleziona tutto

Sub Ambi()
Dim I As Integer: Dim J As Integer: Dim K, R, C As Integer

Range("AD4:AL4100").ClearContents
 Range("AG2") = ""

For I = 1 To 90
For J = 1 + I To 90
'For K = 1 + J To 90                  'TERNO
'If J = I Or K = I Or K = J Then GoTo skip:    '<<< TERNO/-Ambo
If J = I Or K = I Then GoTo skip:             ' <<< AMBO/-Terno
Range("AD2") = R + 1

 Range("AE2") = I
  Range("AF2") = J
 
 
    Range("AD2:AL2").Copy
      [AD4].Offset(R, 0).PasteSpecial _
         Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     R = R + 1
skip:
       
'Next K  'Terno
Next J
Next I
End Sub


allego il file per test
http://www.filedropper.com/10elotto5minutiambi

[Anthony47]

La lentezza e' data dalla massa di formule presenti sul foglio, in gran parte in forma di matrice, alcune di tipo volatili; quindi anche lente e ripetitive nel calcolo.
Se si vuole velocizzare bisogna cambiare gli algoritmi di calcolo. Ad esempio questa macro:

Codice: Seleziona tutto

Sub bAmbi()
Dim myDic As Object, myK As String
Dim wArr() As Long, I As Long, J As Long, aInd As Long
Dim eArr, LastA As Long, K As Long, lLine As Long
Dim oArr(1 To 4005, 1 To 4), aArr(1 To 4005, 1 To 2) As Long
'
Range("AD4:AL4100").ClearContents
'Crea l'array degli Ambi:
Set myDic = CreateObject("Scripting.Dictionary")
For I = 1 To 89
    For J = I + 1 To 90
        myK = I & "_" & J
        aInd = aInd + 1
        myDic.Add myK, aInd
        aArr(aInd, 1) = I
        aArr(aInd, 2) = J
    Next J
Next I
ReDim wArr(1 To aInd, 1 To 3)
'Crea copia delle estrazioni:
eArr = Range(Range("D4"), Range("W4").End(xlDown)).Value
'Calcola dati di ogni Ambo presente in estrazioni:
lLine = UBound(eArr, 1)
For K = 1 To lLine
    For I = 1 To 19
        For J = I + 1 To 20
            myK = eArr(K, I) & "_" & eArr(K, J)
            aInd = myDic.Item(myK)
            wArr(aInd, 1) = wArr(aInd, 1) + 1
                cdel = K - wArr(aInd, 2)
                wArr(aInd, 2) = K
                If cdel > wArr(aInd, 3) And K < lLine Then wArr(aInd, 3) = cdel
        Next J
    Next I
Next K
'Calcola i parametri di ogni ambo:
For I = 1 To UBound(aArr)
    myK = aArr(I, 1) & "_" & aArr(I, 2)
    aInd = myDic.Item(myK)
    oArr(I, 1) = lLine - wArr(aInd, 2)
    oArr(I, 2) = wArr(aInd, 1)
    oArr(I, 4) = wArr(aInd, 3) - 1
    oArr(I, 3) = oArr(I, 1) - oArr(I, 4)
Next I
'
Range("AE4").Resize(UBound(aArr), 2) = aArr     'scrivi gli Ambo
Range("AI4").Resize(UBound(oArr), 4) = oArr     'scrivi i parametri calcolati
'
Set myDic = Nothing
End Sub

Sul foglio vanno cancellate tutte le formule, poi va eseguita la Sub bAmbi, che compilera' le colonne AE:AF e AI:AL

A spanne direi che i risultati sono uguali ai tuoi e il tempo di esecuzione e' inferiore.

Ciao

[Statix]

Ciao Anthony47,
il risultato della macro è a dir poco strabiliante,
ha impiegato meno di un secondo,
visto i tempi da record, inoltre, se non chiedo molto, se puoi fare anche una macro con i terni,
il terzo elemento va in colonna AG.
ti volevo chiedere se puoi commentare la macro passo passo,
per future applicazioni e adattamenti a range diversi
grazie
in colonna AD manca indice

[Statix]

Ciao Anthony47,
per completare le statistiche,
mi occorrono altre 4 macro
ambi 4005 2x1 cioè 2 numeri per ambata
terni
terni 3x1 3 numeri per ambata
terni 3x2 3 numeri x ambo
con la vecchia macro bastava sostituire solo le formule matriciali in colonna AB4:AB903
credo che con piccole modifiche alla tua macro si possa fare.

[Anthony47]

Guarda, io penso di sapere cosa sia un ambo e anche un terno, ma il terno in offerta 3x1 o 3x2 e idem l'ambo 2x1 non so a cosa corrispondono...

[Statix]

Ciao Anthony47,
nel foglio di test metti questa formula matriciale in AB4 e copiala in basso,

Codice: Seleziona tutto

=Se(Somma(Conta.Se($D4:$W4;$AE$2:$AF$2))>0;0;AB3+1)

lancia la mia macro è vedrai come funziona,in realta basta che esce un solo numero dei 2 (Ambo) per azzerare il ritardo,

[Statix]

Ciao Anthony47,
ti allego il file per il test dei terni
terni
terni 3x1
terni 3x2
senza sconto
il tutto funziona tramite la colonna AB , le formule matriciali vengono modificate dalle macro in base al tipo di ricerca sui terni.

http://www.filedropper.com/10elotto5minutiterni_1

[Statix]

Ciao Anthony47,
ho studiato un po' la tua macro degli Ambi,
e sono riuscito a modificarla per i terni,
la macro funziona bene, fatto la verifica dei dati con la mia, che impiegava circa 15 minuti,
questa impiega circa 4/5 secondi,
adesso mi manca ancora quella 2x1, 3x1 e 3x2
sempre senza sconto

Codice: Seleziona tutto

Sub Terni()
Dim myDic As Object, myK As String
Dim wArr() As Long, I As Long, J, H As Long, aInd As Long
Dim eArr, LastA As Long, K As Long, lLine As Long
Dim oArr(1 To 117480, 1 To 4), aArr(1 To 117480, 1 To 3) As Long
'
Range("AD4:AL118000").ClearContents
'Crea l'array degli Terni:
Set myDic = CreateObject("Scripting.Dictionary")
For H = 1 To 88
  For I = H + 1 To 89
    For J = I + 1 To 90
        myK = H & "_" & I & "_" & J
        aInd = aInd + 1
        myDic.Add myK, aInd
        aArr(aInd, 1) = H
        aArr(aInd, 2) = I
        aArr(aInd, 3) = J
    Next J
  Next I
Next H
ReDim wArr(1 To aInd, 1 To 3)
'Crea copia delle estrazioni:
eArr = Range(Range("E4"), Range("X4").End(xlDown)).Value
'Calcola dati di ogni Ambo presente in estrazioni:
lLine = UBound(eArr, 1)
For K = 1 To lLine
  For H = 1 To 18
    For I = H + 1 To 19
        For J = I + 1 To 20
       
             
            myK = eArr(K, H) & "_" & eArr(K, I) & "_" & eArr(K, J)
            aInd = myDic.Item(myK)
            wArr(aInd, 1) = wArr(aInd, 1) + 1
                cdel = K - wArr(aInd, 2)
                wArr(aInd, 2) = K
                If cdel > wArr(aInd, 3) And K < lLine Then wArr(aInd, 3) = cdel
        Next J
     Next I
    Next H
Next K
'Calcola i parametri di ogni ambo:
For I = 1 To UBound(aArr)
    myK = aArr(I, 1) & "_" & aArr(I, 2) & "_" & aArr(I, 3)
    aInd = myDic.Item(myK)
    oArr(I, 1) = lLine - wArr(aInd, 2)
    oArr(I, 2) = wArr(aInd, 1)
    oArr(I, 4) = wArr(aInd, 3) - 1
    oArr(I, 3) = oArr(I, 1) - oArr(I, 4)
Next I
'
Range("AE4").Resize(UBound(aArr), 3) = aArr     'scrive i Terni
Range("AI4").Resize(UBound(oArr), 4) = oArr     'scrivi i parametri calcolati
'
Set myDic = Nothing

End Sub


[Anthony47]

Bravo
Sono in viaggio e ho difficoltà a provare e intervenire, portate pazienza

[papiriof]

Buongiorno Statix , Anthony ho provato la nuova macro per i terni che riduce i tempi a 4 5 secondi ma mi da errore qui
wArr(aInd, 1) = wArr(aInd, 1) + 1

[Statix]

Ciao papiriof,
io ho riprovato la macro da me aggiustata, è funziona perfettamente,provata centinaia di volte,
non mi da nessun errore, e i dati sono stati confrontati tutti i 117480 terni con la mia vecchia macro,
sono tutti esatti, quindi non so dirti ,dobbiamo aspettare Anthony47.

[Statix]

Ciao papiriof,
ho provato su un altro computer, in effetti c'è l'errore,
ma ho notato che dipende dalle estrazioni in colonna,
la macro da me postata era stata modificata con un altro range delle estrazioni,
quindi devi aggiustare questa riga di codice con il tuo range , in questa macro D4 inizio dei 20 estratti W4 fine ,
mentre la mia incomicia con E4 e fine X4

Codice: Seleziona tutto

eArr = Range(Range("D4"), Range("W4").End(xlDown)).Value


[papiriof]

Grazie Statix adesso funge!!!!

[papiriof]

X Statix ho trovato questo post su internet non fa esattamente quello che chiedi ad Anthony ,però penso che , per uno bravo come te , possa dare qualche spunto per affrontare in modo diverso la sisituazione
https://www.excel-downloads.com/posts/20181273/

[Anthony47]

Servo ancora? se "Si", per quale scopo?

[Statix]

Ciao Anthony47
sono da fare le macro 2x1 3x1 3x2
La 2x1 sono 2 numeri per l uscita di un solo mumero nei post ho messo il file esempio

[Statix]

Ciao Anthony47,
ho bisogno ancora del tuo aiuto per delle nuove macro,
questa non riesco a modificarla per fare la statistica del 3 x1 e 3x2,
la macro azzera il ritardo solo se sono presenti tutti i 3 numeri della terzina,
la nuova dovrebbe azzerare il ritardo con l'uscita di 2 numeri della terzina (3X 2)
e l'altra macro azzerare il ritardo con l'uscita di un solo numero della terzina (3x1)
oppure una solo macro con una scelta , 3x1 o 3x2

[Anthony47]

Non ti ho dimenticato, ma avrai notato che faccio fatica a partecipare alle discussioni.
Insomma se hai pazienza hai anche una speranza
Ciao

[Flash30005]

Ciao a tutti
Volevo provare a vedere il problema ma non esiste più il file originale

[Statix]

Ciao a tutti,
allego di nuovo il link per il test dei terni 3x1 e 3x2,
il file è perfettamente funzionante ma impiega molti minuti,
http://www.filedropper.com/10elotto5minutiterni



per i terni ho già risolto con la macro postata nei post precedenti, ed impiega circa 8 secondi.
adesso servirebbe modificarla per la statistica 3x1 e 3x2 .