Condividi:        

Calcolo 4005 ambi

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Calcolo 4005 ambi

Postdi Statix » 13/06/18 20:27

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
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Calcolo 4005 ambi

Postdi Anthony47 » 14/06/18 00:11

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
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Calcolo 4005 ambi

Postdi Statix » 14/06/18 07:56

Ciao Anthony47,
il risultato della macro è a dir poco strabiliante,
ha impiegato meno di un secondo, :o :o :o :o
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
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Statix » 14/06/18 13:55

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.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Anthony47 » 14/06/18 15:07

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...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Calcolo 4005 ambi

Postdi Statix » 14/06/18 16:37

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
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Statix » 14/06/18 21:42

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
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Statix » 17/06/18 20:19

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
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Anthony47 » 17/06/18 23:10

Bravo
Sono in viaggio e ho difficoltà a provare e intervenire, portate pazienza
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Calcolo 4005 ambi

Postdi papiriof » 18/06/18 07:42

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
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Calcolo 4005 ambi

Postdi Statix » 18/06/18 08:26

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
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Statix » 18/06/18 09:16

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
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi papiriof » 18/06/18 16:14

Grazie Statix adesso funge!!!! :) :)
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Calcolo 4005 ambi

Postdi papiriof » 19/06/18 12:13

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/
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Calcolo 4005 ambi

Postdi Anthony47 » 21/06/18 18:33

Servo ancora? se "Si", per quale scopo?
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Calcolo 4005 ambi

Postdi Statix » 21/06/18 19:35

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
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Statix » 25/06/18 10:49

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
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Calcolo 4005 ambi

Postdi Anthony47 » 26/06/18 01:29

Non ti ho dimenticato, ma avrai notato che faccio fatica a partecipare alle discussioni.
Insomma se hai pazienza hai anche una speranza :D
Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Calcolo 4005 ambi

Postdi Flash30005 » 26/06/18 02:33

Ciao a tutti
Volevo provare a vedere il problema ma non esiste più il file originale
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Calcolo 4005 ambi

Postdi Statix » 15/07/18 18:22

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 .
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Calcolo 4005 ambi":


Chi c’è in linea

Visitano il forum: Nessuno e 142 ospiti