Condividi:        

Ambo e Terno più ritardati su"TUTTE"

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

Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 31/01/17 12:33

Ho questo file di excel si tratta di un lotto estero formato da 42 numeri e ogni estrazione è formata da 6 numeri in effetti si tratta
di una sola ruota ma con un artifizio ho aggiunto altre 6 ruote diciamo così "virtuali" con cui però si riesce a ricavare i numeri per eventualmente giocare sulla ruota reale .Quello che vorrei trovare è l'amboed eventualmente anche il terno piu ritardati non sulle singole ruote ma su tutte(reale e virtuali)
http://www.filedropper.com/ambotutteritpiu
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Sponsor
 

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 31/01/17 23:45

Per scopi puramente ludici ho sviluppato questo codice:
Codice: Seleziona tutto
Dim wArr, cMax As Long, aMax As String, mRes(1 To 42, 1 To 42) As Long

Sub maxAmbo()
Dim dMax As Long, lastR As Long, lastC As Long
Dim I As Long, J As Long

lastR = Cells(Rows.Count, "A").End(xlUp).Row
lastC = Cells(2, Columns.Count).End(xlToLeft).Column
wArr = Range("A1").Resize(lastR, lastC).Value
For I = 1 To 41
    For J = I + 1 To 42
        Call ckDel(I, J)
    Next J
Next I
''Range("AT4").Resize(42, 42) = mRes
MsgBox ("Max ritardatario: " & aMax & " da: " & cMax)
End Sub

Sub maxTerno()
Dim dMax As Long, lastR As Long, lastC As Long
Dim I As Long, J As Long, K As Long

lastR = Cells(Rows.Count, "A").End(xlUp).Row
lastC = Cells(2, Columns.Count).End(xlToLeft).Column
wArr = Range("A1").Resize(lastR, lastC).Value
For I = 1 To 40
    For J = I + 1 To 41
        For K = J + 1 To 42
            Call ckDel(I, J, K)
        Next K
    Next J
Next I
MsgBox ("Max ritardatario: " & aMax & " da: " & cMax)
End Sub

Function ckDel(ByVal iNum As Long, jNum As Long, Optional kNum As Long = 0) As Long
Dim flExit As Boolean, ccI As Boolean, ccK As Boolean, ccJ As Boolean
'
If kNum = 0 Then kNum = jNum
For I = UBound(wArr, 1) To LBound(wArr, 1) Step -1
    For J = LBound(wArr, 2) + 2 To UBound(wArr, 2) Step 6
        ccI = (wArr(I, J) = iNum) Or (wArr(I, J + 1) = iNum) Or (wArr(I, J + 2) = iNum) Or (wArr(I, J + 3) = iNum) Or (wArr(I, J + 4) = iNum) Or (wArr(I, J + 5) = iNum)
        ccJ = (wArr(I, J) = jNum) Or (wArr(I, J + 1) = jNum) Or (wArr(I, J + 2) = jNum) Or (wArr(I, J + 3) = jNum) Or (wArr(I, J + 4) = jNum) Or (wArr(I, J + 5) = jNum)
        ccK = (wArr(I, J) = kNum) Or (wArr(I, J + 1) = kNum) Or (wArr(I, J + 2) = kNum) Or (wArr(I, J + 3) = kNum) Or (wArr(I, J + 4) = kNum) Or (wArr(I, J + 5) = kNum)
        If ccI And ccK And ccJ Then
            flExit = True
            mRes(iNum, jNum) = UBound(wArr, 1) - I
            If (UBound(wArr, 1) - I) > cMax Then
                cMax = UBound(wArr, 1) - I
                aMax = Format(iNum, "00") & " # " & Format(jNum, "00") & " # " & Format(kNum, "00")
            End If
        End If
        If flExit Then Exit For
    Next J
    DoEvents
    If flExit Then Exit For
Next I

End Function

Metti tutto in un "Modulo standard del vba" contenente null'altro.
Lanciare la Sub maxAmbo per conoscere l'ambo con maggior ritardo, e Sub maxTerno per il terno.

Il messaggio finale sara' del tipo:
05 # 10 # 10 (ambo o terno individuato) da: 55 (ritardo)

In caso di ricerca dell'ambo la sequenza del risultato riportera' 2 (dei 3) numeri uguali.

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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 01/02/17 10:42

Grazie Anthony, ho fatto come da istruzioni ho messo un bottone a cui ho associato la macro dell'ambo......tutto bene
poi misono creato un altro bottone e associato il nome della macro del terno provata e tutto OK .Riprovo l'ambo ma mi dail risultato del terno :?: :?: :?: ho anche cancellato il bottone del terno ma clic sul bottone del ambo mi da sempre il risultato del terno , è come se perdesse l'aggancio al bottone (dell'ambo) mi da sempre il risultato del terno . Forse ho qualche virus ? non è la prima volta che associo una macro ad un bottone. adesso mi da sempre il risultato del terno .solo la prima volta e uscito quello dell'ambo :cry: :cry: :cry: :cry: :cry: .Devo segnalare che io uso solo il mause e da un poco di tempo fa le bizze nel senso che se io faccio un copia e incolla nella cella di destinanione mi appare la linetta verticale per cui non posso incollare, ho comprato un nuovo mause ma è la stessa cosa...un consiglio per questo inconveniente è come se il mouse facesse due clik consecutivi ...per cui si immette dentro la cella e a quel punto non posso incollare , non credo sia troppo sensibile , ripeto con un mouse nuovo è la stessa cosa. Ho detto questo particolare perchè forse c'è un nesso
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 03/02/17 00:53

Eh, dovro' mica azzerare i contatori prima di ogni nuova misura?
Aggiungi questa riga in questa posizione in ambedue le Sub:
Codice: Seleziona tutto
Dim I As Long, J As Long
cMax = 0: aMax = ""             '<<<<<<<<< AGGIUNGI
lastR = Cells(Rows.Count, "A").End(xlUp).Row

Quanto al mouse, la mia impressione e' che l'impostazione del ritardo sul doppioclick sia da rivedere: Pannello di controllo, cerca Mouse e cliccalo; tab Pulsanti, area Velocita' doppio click; prova a modificare l'impostazione.

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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 03/02/17 11:10

Grazie Anthony, ti rispondo dal PC fisso in quanto il portatile che usavo e in cui riscontravo quelle anomalie l'ho portato da un tecnico.
Mettiamo un poco d'ordine la tua soluzione nel PC fisso funziona perfettamente solo che , per quanto riguarda la ricerca del terno mi sembra esagerato che ci metta quasi 2 minuti!! Tutto questo sia prima dell'ultima modifica che con
Codice: Seleziona tutto
Dim I As Long, J As Long
cMax = 0: aMax = ""             '<<<<<<<<< AGGIUNGI
lastR = Cells(Rows.Count, "A").End(xlUp).Row
insomma l'ultimo suggerimento sembra essere ininfluente.
Tornando invece al portatile mi sono arreso a portarlo dal tecnico perché oltre a quanto detto in precedenza non riuscivo più neanche ad agganciare a un bottone le macro, succedeva questo : quando, avendo il bottone ,Tasto dx su di esso --->menu a tendina---> assegna macro .... nella successiva finestra dove si scelgono le macro cliccando su una di quelle propostomi non veniva "assunta" la macro scelta ma il riferimento tipo(R 10 C14) ovvero riga e colonna che si trovavano proprio sotto dove avevo cliccato per scegliere la macro. Troppo per me, mi piacerebbe sentire la tua opinione o di qualcun altro che gli è capitato una cosa simile.
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 04/02/17 19:50

La ricerca del terno richiedera' circa 40 volte il tempo richiesto per l'ambo; la macro gia' lavora solo il memoria, non saprei come velocizzarla.

Quanto al difetto, credo che hai fatto bene a portare la bestia da un tecnico; al massimo io ti avrei suggerito di fare un "Ripristino di Office"

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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 05/02/17 18:31

Grazie Anthony ,ho approfittato a mettere excel 10 (un passetto alla volta) :) .Volevo informarti della situazione attuale , in ecxel 10 dopo aver tolto tutta la monnezza ancora,in modo più attenuato, ho quel difetto,speriamo che non aumenti!!!
Ho fatto un esperimeno ,sempre in quel file prima dell'esperimento l'ambo più ritardato era 21#40#40 da:61 controllato , tutto a posto! Allora , per curiosità mi sono chiesto quale fosse il secondo ambo, così semplicemente nell'ultima estrazione ho messo i valori 21 e 40 e fatto ripeere la macro e .... un brivido mi è uscito ancoora era 21#40#40 da:61 allora ho salvato il file con 21 e 40 nell'ultima estraz ma sempre lo stesso poi, non ricordo se ho addirittura chiuso e finalmente mi ha dato un altro ambo.Secondo Te mi devo preoccupare, nel senso mi potrebbero capitare cose strane?
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 07/02/17 01:44

Quando io eseguo la MaxAmbo ho come risultato 21-40 (-49) e 60.
Se inserisco 21-40 sull'ultima estrazione (la #425 su riga 425) ottengo 3-39 (-39) con 53
Quindi la domanda e' se hai modificato la macro originale con l'aggiunta della riga
Codice: Seleziona tutto
cMax = 0: aMax = ""             '<<<<<<<<< AGGIUNGI


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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 07/02/17 10:45

Hai ragione Anthony , credevo di aver fatto quella giunta ma, pur provandola,poi non l'avevo salvata!
Ora è tutto giusto ,curioso il fatto che nel frattempo ci sono state altre due estrazioni e il 3 e 39 è uscito all'estrazione successiva alla 427... ripetuta la macro il secondo ambo più ritardato (dato che il primo lo avevo artificialmente fatto uscire) era 17 e 25 ma alla 428 usciva anche questo
Codice: Seleziona tutto
 427   01/02/2017   1   14   18   22   28   29   42   13   17   21   27   28   41   12   16   20   26   27   38   9   13   17   23   24   29   42   4   8   14   15   18   31   35   39   3   4   1   14   18   22   28   29
428   04/02/2017   1   4   7   9   11   35   42   3   6   8   10   34   29   32   35   37   39   21   25   28   31   33   35   17   21   24   27   29   31   13   15   18   21   23   25   7   14   17   20   22   24   6
per cui la situazione aggiornata è 21 e 40 rit 62 al secondo posto con un rit di 45 estr passa 9 e 19
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 08/02/17 03:22

Se e' tutto regolare allora "alla prossima!"
Avatar utente
Anthony47
Moderatore
 
Post: 19181
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 21/02/17 12:58

Una richiesta legata a questo post vorrei cambiare le cooridinate alla macro che mi ha fatto Anthony ora si tratta di una diversa disposizione dei dati. La richiesta precedente come si vede dal file inviato in precedenza concerneva di trovare l'ambo + ritardato su "tutte le ruote" ovvero su un intervallo che partiva dalla prima riga fino alla colonna AR in effetti la macro cercava l'ambo dalla colonna C datosi che le colonne A e B contengono un numero progressivo e una data . La presente richiesta concerne una richiesta simile che nonostante la mia applicazione non rieco a venirne a capo. La richiesta è la stessa, trovare l'ambo e il terno più titardato le cooridnate sono però le seguenti: le ruote sono 6 invece che 7 sono formate da 5 numeri invece che dai 6 precedenti i numeri 90 invece che 42 della precedente richiesta L'intervallo parte dalla riga 3 le prime 3 colonne sono occupate le, successive30 sono le effettive colonne(6 x 5) dove cercare l'ambo spero di essere stato chiaro e che il link che ho messo si veda.
https://postimg.org/image/ozf0wujl5/
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 22/02/17 14:39

Come da "Linee guida per pubblicare le vostre domande":
Se i dati da elaborare sono particolari o richiedono piu' di 2 (due) minuti per essere ricreati da chi vuole aiutarvi, allora e' bene allegare un file esemplificativo.
Direi che e' il tuo caso.

Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 22/02/17 16:23

invio il file molto semplificato formato di soli valori. In sostanza è la stessa richiesta del di cui al n° 1 discosta da essa perchè i num invece di 42 sono 90 le ruote invece di 7 sono 6 e le estrazioni non sono formate da 6 num ma da 5 per cui le celle da analizzare sono 30 invece di 42 e iniziano come si vede nel file allegato da "D3".
Ho tentato di modificare adattare le macro (compresa la Function) precedente ma come si vede mi da "indice non compreso nell'intervallo" ho provato e riprovato ma non sono capace :( :(
http://www.filedropper.com/aaaaaaa_2
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 24/02/17 00:02

Nel tuo file devi cambiare queste due:
Codice: Seleziona tutto
wArr = Range("A3").Resize(lastR, lastC).Value
(in due posti)

Codice: Seleziona tutto
    For J = LBound(wArr, 2) + 3 To UBound(wArr, 2) Step 5

Queste sono gia' le versioni modificate

I tempi di esecuzione non sono bassi; e il terno richiede 90 volte i tempi dell'ambo... (azz)

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

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi papiriof » 25/02/17 08:46

Grazie Anthony , con questi piccoli ultimi suggerimenti va ma forse la richiesta del terno è eccessivaper cui bisognerebbe toglierla anche perchè ogni volta che al file vado ad aggiungere ,o togliere, qualche cosa, e rilancio la macro ci mette talmente tanto tempo
che presumo voglia cercare il terno.Per controllare le ricerche ho aggiunto una formaattazione condizionale euna colonna AL e ci sono volute innumerevoli prove empiriche per giungere al file sottonotato che funziona, ma si provi atogliere la colonna AL e , come detto , nel nuovo scenario presumo si metta a cercare il terno(?)
http://www.filedropper.com/aaaaaaa_3
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 392
Iscritto il: 16/02/10 13:23

Re: Ambo e Terno più ritardati su"TUTTE"

Postdi Anthony47 » 26/02/17 02:29

Ho trovato una codifica per la Function ckDel decisamente piu' veloce, corrispondente a questo codice e che sostituisce integralmente il precedente:
Codice: Seleziona tutto
Function ckDel(ByVal iNum As Long, jNum As Long, Optional kNum As Long = 0) As Long
Dim flExit As Boolean, ccI As Boolean, ccK As Boolean, ccJ As Boolean
'
For I = UBound(wArr, 1) To LBound(wArr, 1) Step -1
    For J = LBound(wArr, 2) + 3 To UBound(wArr, 2) Step 5
    ccI = False: ccJ = False
        If (wArr(I, J) = iNum) Then
            ccI = True
        ElseIf (wArr(I, J + 1) = iNum) Then
            ccI = True
        ElseIf (wArr(I, J + 2) = iNum) Then
            ccI = True
        ElseIf (wArr(I, J + 3) = iNum) Then
            ccI = True
        ElseIf (wArr(I, J + 4) = iNum) Then
            ccI = True
        End If
       
        If (wArr(I, J) = jNum) Then
            ccJ = True
        ElseIf (wArr(I, J + 1) = jNum) Then
            ccJ = True
        ElseIf (wArr(I, J + 2) = jNum) Then
            ccJ = True
        ElseIf (wArr(I, J + 3) = jNum) Then
            ccJ = True
        ElseIf (wArr(I, J + 4) = jNum) Then
            ccJ = True
        End If
   
        If kNum = 0 Then
            ccK = True
        ElseIf (wArr(I, J) = kNum) Then
            ccK = True
        ElseIf (wArr(I, J + 1) = kNum) Then
            ccK = True
        ElseIf (wArr(I, J + 2) = kNum) Then
            ccK = True
        ElseIf (wArr(I, J + 3) = kNum) Then
            ccK = True
        ElseIf (wArr(I, J + 4) = kNum) Then
            ccK = True
        End If
        If ccI And ccK And ccJ Then
            flExit = True
            mRes(iNum, jNum) = UBound(wArr, 1) - I
            If (UBound(wArr, 1) - I) > cMax Then
                cMax = UBound(wArr, 1) - I
                aMax = Format(iNum, "00") & " # " & Format(jNum, "00") & " # " & Format(kNum, "00")
            End If
        End If
        If flExit Then Exit For
    Next J
'    DoEvents
    If flExit Then Exit For
Next I
End Function

Tuttavia, anche se i tempi di calcolo degli ambo sono abbastanza contenuti, c'e' da considerare che per il calcolo dei terni questi tempi sono da moltiplicare almeno per 90 (ma piu' probabilmente per 130-150).

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


Torna a Applicazioni Office Windows


Topic correlati a "Ambo e Terno più ritardati su"TUTTE"":


Chi c’è in linea

Visitano il forum: Nessuno e 53 ospiti

cron