Condividi:        

Velocizzare macro per terni

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

Velocizzare macro per terni

Postdi ikwae » 17/05/18 11:34

Ciao a tutti, sono qui ancora a chiedere il vostro prezioso e gradito aiuto.

Ho una macro che conta nell’archivio tutti i valori delle terzine e poi li scrive sul foglio Terni in colonna H partendo dalla cella H3. Questa macro è nata per i terni del Super Enalotto in un modulo del foglio e io l’ho messa in un modulo standard e l’ho modificata (come ho saputo) per i terni del lotto. Ormai da anni che la uso normalmente è sembra che è tutto ok.
Adesso la vorrei inserire in una procedura automatica dove in archivio ci sono migliaia di righe di cinquine, sempre in aumento, ma è molto lenta quindi l’aiuto che cerco è, se possibile, velocizzare il più possibile.

Attualmente per 120.000 cinquine, presenti nell’archivio range G2:K(end) impiega 1 ora e rotti quindi non molto felice in velocità. Aggiungo oltre ai riferimenti già scritti per l’archivio che è sul foglio Archivio anche i terni sul foglio Terni. Le 117.480 terzine iniziano dal range E3:G117482 e come scritto i valori in colonna H iniziando da H3:H117482. Allego un foglio per eventuale prove. Se non si riesce a modificare la macro proposta e, ci sono altri suggerimenti, sono molto apprezzati e graditi. Ringraziando anticipatamente tutti colore che mi aiuteranno. 73 ikwae

http://www.filedropper.com/velocizzaremacroterni

Codice: Seleziona tutto
Sub FREQUENZA_TERNI()
'DISATTIVO LE APPLICAZIONI

Dim xlCal As XlCalculation
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    xlCal = .Calculation
    .Calculation = xlCalculationManual
End With

Dim aTotTerni() As Variant, aTabellone() As Variant, aNew(1 To 117480, 1 To 1) As Variant
Dim lRiga1 As Long, lRiga2 As Long
Dim iN1 As Integer, iN2 As Integer, iN3 As Integer, iTot As Integer, nSortSI As Integer, nSortNO As Integer, iCol As Integer
Dim T As Date
Dim WS1 As Worksheet, WS2 As Worksheet

Set WS1 = Sheets("Terni")
Set WS2 = Sheets("Archivio")

T = Now

With WS1
     'sestine
     'aTabellone = WS2.Range("G2:L" & WS2.Range("L" & Rows.Count).End(xlUp).Row)
   
    'cinquine
     aTabellone = WS2.Range("G2:K" & WS2.Range("K" & Rows.Count).End(xlUp).Row)
     
     aTotTerni = .Range("E3:G117482")
    .Range("H3:H117482").ClearContents
   
    For lRiga1 = LBound(aTotTerni) To UBound(aTotTerni)
        iN1 = aTotTerni(lRiga1, 1)
        iN2 = aTotTerni(lRiga1, 2)
        iN3 = aTotTerni(lRiga1, 3)
        For lRiga2 = LBound(aTabellone) To UBound(aTabellone)
            'sestine
            'For iCol = 1 To 6
           
            'cinquine
            For iCol = 1 To 5
                If aTabellone(lRiga2, iCol) = iN1 Or _
                    aTabellone(lRiga2, iCol) = iN2 Or _
                    aTabellone(lRiga2, iCol) = iN3 Then
                    nSortSI = nSortSI + 1
                    If nSortSI = 3 Then
                        iTot = iTot + 1
                        Exit For
                    End If
                Else
                   nSortNO = nSortNO + 1
                   If nSortNO = 4 Then Exit For
                End If
            Next iCol
            nSortSI = 0
            nSortNO = 0
        Next lRiga2
        aNew(lRiga1, 1) = iTot
        iTot = 0
    Next lRiga1
        .Range("H3:H117482") = aNew()
        .Range("A1").Select
End With
Set WS1 = Nothing
Set WS2 = Nothing

'RIATTIVO LE APPLICAZIONI
With Application
    .Calculation = xlCal
    .EnableEvents = True
    .ScreenUpdating = True
End With
Range("A1").Select
MsgBox Format(Now - T, "HH:MM:SS"), vbInformation, "codice eseguito in........."
End Sub
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Sponsor
 

Re: Velocizzare macro per terni

Postdi Francesco53 » 17/05/18 16:09

Ciao ikwae,
il calcolo lo devi fare solo una volta, poi ti salvi l'ultima riga dell'Archivio nel foglio Terni Cella A2,
Le volte successive fai il controllo solo sulle righe aggiunte nell'Archivio e i risultati li sommi ai precedenti.
In pochi secondi aggiorni le presenze.
Francesco
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Re: Velocizzare macro per terni

Postdi ikwae » 17/05/18 16:32

Ciao Francesco53, grazie per la risposta ma non cerco l'aggiornamento quello lo fa quotidianamente nel prg che lo uso normalmente. A me serve che di volta in volta mi faccia la scansione di tutte le cinquine in archivio e non l'aggiornamento. Le cinquine cambiano di volta in volta quindi non sono da aggiornare ... comunque grazie lo stesso. 73 ikwae
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi ikwae » 19/05/18 15:50

Ciao a tutti, attendo fiducioso che qualche aiuto arriva altrimenti grazie lo stesso.
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi Francesco53 » 19/05/18 20:59

Scusa ma dopo che aggiorni l'archivio, cambiano tutte le cinquine?
Francesco
P.S.: io non ti ho parlato di aggiornare archivio ma i terni, dopo l'aggiunta di nuove cinquine.
S.O. Windows 10 e Office 2007
Avatar utente
Francesco53
Utente Senior
 
Post: 811
Iscritto il: 20/02/10 18:45

Re: Velocizzare macro per terni

Postdi ikwae » 19/05/18 21:47

Ciao Francesco, è una procedura particolare... spiego brevemente le fasi .. la prima: vengono generate milioni di cinquine e vengono filtrate con determinati criteri e quelle filtrate vengono convertite in ambi o terni o quaterne .. la seconda: da questi ambi o terni o quaterne vengono formate 18 cinquine che contengono i 90 numeri ... terza: vengono confrontate con l'estrazione che deve uscire e si confronta il risultato e si mette da parte ... ritorna alla prima a fare milioni di cinquine ecc... ecc... Quindi servono macro super veloci già ho avuto notevoli aiuti su altre macro a velocizzarle e manca velocizzare la macro dei terni e la trasformazione da cinquine in quartine che sarà l'aiuto che cercherò la prossima volta. cordialmente ikwae
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi Anthony47 » 19/05/18 22:42

Questa dovrebbe essere piu' veloce:
Codice: Seleziona tutto
Sub FasTerni()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109760&p=644015#p644015
Dim aTerni, aArch, myDic As Object, MapT
Dim shT As Worksheet, shA As Worksheet, lastA As Long
Dim I As Long, myK As String, J As Long, myTim As Single
Dim ccc(1 To 3), myInd As Long, oArr(1 To 117480, 1 To 1) As Long

myTim = Timer
Set shT = Sheets("Terni")
Set shA = Sheets("Archivio")
Set myDic = CreateObject("Scripting.Dictionary")
lastA = shA.Cells(Rows.Count, "G").End(xlUp).Row
''lastA = 10000
shT.Range("H3:H117482").ClearContents
'
aTerni = shT.Range("E3:G117482").Value
aArch = shA.Range("G2:K" & lastA).Value
MapT = shT.Range("Q3").CurrentRegion.Value
'
'Crea dizionario di chiavi:
For I = 1 To UBound(aTerni, 1)
    myK = aTerni(I, 1) & "_" & aTerni(I, 2) & "_" & aTerni(I, 3)
    myDic.Add myK, I
Next I
'Somma i terni presenti:
For I = 1 To UBound(aArch)
    For J = 1 To UBound(MapT, 1)
        ccc(1) = aArch(I, MapT(J, 1)): ccc(2) = aArch(I, MapT(J, 2)): ccc(3) = aArch(I, MapT(J, 3))
        k1 = Application.WorksheetFunction.Min(ccc)
        k3 = Application.WorksheetFunction.Max(ccc)
        k2 = Application.WorksheetFunction.Large(ccc, 2)
        myK = k1 & "_" & k2 & "_" & k3
        myInd = myDic.Item(myK)
        oArr(myInd, 1) = oArr(myInd, 1) + 1
    Next J
Next I
'Scrivi il risultato:
shT.Range("H3:H117482") = oArr
MsgBox ("Completato in (sec): " & Format(Timer - myTim, "0.00"))
End Sub

E' integrata nel file reperibile qui: https://www.dropbox.com/s/4hq896tjpsd5h ... .xlsm?dl=0
Per comodita' ho usato una tabella di mapping dei terni (sul foglio Terni si trova in Q3:S12).

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Velocizzare macro per terni

Postdi ikwae » 19/05/18 23:15

Gentilissimo Anthony47, gentile e disponibile come sempre sapevo che se aspettavo qualche cosa arrivava quindi ... Ho lanciato ma macro e in pochissimi secondi ha dato il risultato quindi molto felice e contento poi ho generato 150.000 cinquine e li ha conteggiate in poco meno di 15 secondi e dico secondi contro l'ora e rotti della mia macro. Quindi super contento. Ringraziandoti mille e mille volte per il tuo generoso e gradito tempo che mi hai concesso. Cordialmente ikwae
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi raimea » 20/05/18 06:13

ciao "ikwae"

se possibile, sarei interessato al file finale

ciao
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Velocizzare macro per terni

Postdi ikwae » 20/05/18 07:52

Ciao raimea, certamente come lo finisco lo metterò a disposizione di tutti, come faccio di solito... ma se hai letto su manca ancora la macro che converte le cinquine in quartine quindi ci vuole ancora un pò...

@Anthony47 dopo aver sostituito tutte le mie macro dei vari programmi che convertono i terni mi sono accorto che non servono più gli aggiornamenti o altri trucchetti per aggiornare con un macro così veloce di pochi secondi .Quindi posso dire, per quanto mi riguarda, che hai scritto una macro che rimarrà nella Storia dei terni ... Complimenti e grazie ancora
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi Anthony47 » 20/05/18 22:48

Vista l'eccitazione creata dalla soluzione proposta ho voluto sperimentare una versione leggermente piu' sofisticata che non usa le WorksheetFunction; inoltre ho modificato la compilazione dell'array MapT, che ora non richiede piu' la mappa inserita sul foglio in Q3:S12 (ma viene compilata da codice).
Il risultato e' questo codice, gia' integrato nel file scaricabile allo stesso link pubblicato:
Codice: Seleziona tutto
Sub FasTerni2()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109760&p=644015#p644015
Dim aTerni, aArch, myDic As Object, MapT(1 To 10, 1 To 3)
Dim shT As Worksheet, shA As Worksheet, lastA As Long
Dim I As Long, myK As String, J As Long, myTim As Single
Dim cCc(1 To 3), myInd As Long, oArr(1 To 117480, 1 To 1) As Long
Dim cippaT, K As Long

myTim = Timer
Set shT = Sheets("Terni")
Set shA = Sheets("Archivio")
Set myDic = CreateObject("Scripting.Dictionary")
lastA = shA.Cells(Rows.Count, "G").End(xlUp).Row
''lastA = 10000
'Application.ScreenUpdating = False
shT.Range("H3:H117482").ClearContents
'
aTerni = shT.Range("E3:G117482").Value
aArch = shA.Range("G2:K" & lastA).Value
''MapT = shT.Range("Q3").CurrentRegion.Value
'Compilazione MapT:
cippaT = Array(1, 2, 3, 1, 2, 4, 1, 2, 5, 1, 3, 4, 1, 3, 5, 1, 4, 5, 2, 3, 4, 2, 3, 5, 2, 4, 5, 3, 4, 5)
For I = 1 To 10
    For J = 1 To 3
        MapT(I, J) = cippaT(K)
        K = K + 1
    Next J
Next I
'
'Crea dizionario di chiavi:
For I = 1 To UBound(aTerni, 1)
    myK = aTerni(I, 1) & "_" & aTerni(I, 2) & "_" & aTerni(I, 3)
    myDic.Add myK, I
Next I
'Somma i terni presenti:
For I = 1 To UBound(aArch)
    Call bSort5X(aArch, I)
    For J = 1 To UBound(MapT, 1)
        myK = aArch(I, MapT(J, 1)) & "_" & aArch(I, MapT(J, 2)) & "_" & aArch(I, MapT(J, 3))
        myInd = myDic.Item(myK)
        oArr(myInd, 1) = oArr(myInd, 1) + 1
    Next J
Next I
'Scrivi il risultato:
shT.Range("H3").Resize(UBound(oArr), 1) = oArr
'Application.ScreenUpdating = True
MsgBox ("Completato in (sec): " & Format(Timer - myTim, "0.00"))
End Sub


Function bSort5X(ByRef sArr, ByVal iI As Long)
'Sort Estrazioni:
Dim tC As Long, nSW As Boolean, UB As Long, I As Long, J As Long
Dim mInd As Long, mArr As Long
'
UB = UBound(sArr, 2)
For J = 1 To UB - 1
mArr = sArr(iI, J)
    For I = J + 1 To UB
        If sArr(iI, I) < mArr Then
            mArr = sArr(iI, I)
            mInd = I
        End If
    Next I
    If mInd > 0 Then
        sArr(iI, mInd) = sArr(iI, J)
        sArr(iI, J) = mArr
        mInd = 0
    End If
Next J
End Function

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Velocizzare macro per terni

Postdi raimea » 21/05/18 17:06

ciao
io a questo link non riesco a scaricare

https://www.dropbox.com/s/4hq896tjpsd5h%20...%20.xlsm?dl=0

succede ad altri ?
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Velocizzare macro per terni

Postdi Anthony47 » 21/05/18 18:35

Non devi copiare il testo che vedi nel mio messaggio precedente, ma cliccarci sopra; sarai indirizzato a
Codice: Seleziona tutto
https://www.dropbox.com/s/4hq896tjpsd5her/byIKWAE_VELOCIZZARE%20MACRO%20TERNI_B80517.xlsm?dl=0


Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Velocizzare macro per terni

Postdi raimea » 21/05/18 20:59

certo , certo.....

ma questo link non porta a nulla
ho provato sia con IE che con Chrome
ma blocca tutto e non risponde mai.

Immagine
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Velocizzare macro per terni

Postdi ikwae » 22/05/18 20:57

Ciao a tutti, ho letto poco prima i vari commenti e ho scaricato il nuovo listato per dare una risposta completa. Quindi dico che è super e aggiungo super MERAVIGLIOSA. Se prima col la precedente macro poteva esserci un barlume di speranza di realizzare una macro più veloce adesso con questa macro anzi “macro missile” le porte della velocità sono chiuse, anche se si sa che è tutto migliorabile, ma dopo questa macro il tempo di migliorare si allunga nel secondo capitolo perché il primo è SCRITTO.... detto questo ha caricato tondo-tondo un milione di cinquine e, la macro, li ha conteggiate con un tempo doppio rispetto alle 150.000 altre parole sono inutili...
Ho anche letto che ci sono difficoltà a reperire il file quindi allego un file con le tre macro la misera (la mia), la macro buona e la macro siluro ... Grazie ancora Anthony47 e alla prossima .... cordialmente ikwae

http://www.filedropper.com/byikwaeveloc ... 517seconda
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi Anthony47 » 22/05/18 23:12

Ma tu da dropbox sei riuscito a scaricare il file? Perche' filedropper tra tre giorni scade...
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Velocizzare macro per terni

Postdi ikwae » 22/05/18 23:58

L'ho scaricato appena lo hai messo ed è andato tutto bene è lo stesso che ho allegato questa sera dopo aver aggiunto la nuova macro con il copia e incolla l'ho provata e l'ho rimesso in allegato. Se lo apri vedi che c'è il tuo tasto lancia macro e un milione di cinquine ... Dato che ho letto che ci sono difficoltà ho voluto metterlo ancora un link nuovo per dare, a chi lo cerca, il foglio con le macro completo. Cordialmente ikwae
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi raimea » 23/05/18 06:05

ciao
questa volta dal link messo da - ikwae-
ho scaricato normalmente in pochi secondi.

grazie
S.O. win10, Excell 2019
Avatar utente
raimea
Utente Senior
 
Post: 1410
Iscritto il: 11/02/10 07:33
Località: lago

Re: Velocizzare macro per terni

Postdi ikwae » 23/11/18 22:31

Gentilissimo Anthony ... riapro questo post per modificare la macro "Sub FasTerni2()" per leggere in un archivio da 6 colonne e convertirla in terni ... ho tentato di fare qualche cosa ma da sempre errore alcuni "smanettando" :evil: sono riuscito ad eliminarli ma questo errore segnalato con il segno del maggiore non riesco proprio a eliminarlo :oops: penso che ci vorranno pochissimi minuti di tempo perché la macro c'è già è solo da mettere a posto ... allego un file per eventuali prove e ringraziandoti anticipatamente per l'aiuto che mi dai Cordialmente ikwae

http://www.filedropper.com/archivioda6colonneperterni
Excel 2007
Avatar utente
ikwae
Utente Senior
 
Post: 309
Iscritto il: 27/12/17 23:14

Re: Velocizzare macro per terni

Postdi Anthony47 » 24/11/18 13:21

E' possibile che nelle sestine di partenza figuri in una riga due volte lo stesso numero? Come succede su riga 3 col num. 21?

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Velocizzare macro per terni":


Chi c’è in linea

Visitano il forum: Ricky0185 e 43 ospiti