Condividi:        

[Excel] Repetite Iuvant.........Ritardi ambo()

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

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 13/05/09 23:56

Prendendo lo spunto da quanto da te suggerito in PM, di lavorare solo sul foglio Archivio senza utilizzare Ritardi_Ambo, ho imbastito qualche macro
Innanzitutto sul foglio Archivio va inserito il seguente codice
Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B6:BA6")) Is Nothing Then Exit Sub
NomeR = ActiveCell.Value
If NomeR = "T" Then
    NomeR = "TUTTE LE RUOTE"
End If
RRuota = Target.Column
RRP = RRuota + 4
If RRuota = 2 Then RRP = 57
Cancel = True
Call CercaAmbo
End Sub

Poi nel modulo vanno inserite queste 4 macro
Codice: Seleziona tutto
Sub CercaAmbo()
RAMBO = 0
MRAMBO = 0
Freq = 0
If Worksheets("Archivio").Range("E3").Value = "A" Then
    Worksheets("Archivio").Range("E3").Value = "M"
    Call CercaAutomArch
    Exit Sub
End If
Ambo = Worksheets("Archivio").Range("B3").Value
Worksheets("Archivio").Select
Ue = Worksheets("Archivio").Range("C" & Rows.Count).End(xlUp).Row
    Range(Cells(8, 3), Cells(Ue, 57)).Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0

    For R = 8 To Ue
    If RRuota = 2 Then RRuota = 3
    For Col1 = RRuota To RRP
       XCF = Int((Col1 - 2) / 5) * 5 + 7
       'XCF = XC + 4
        AA = Cells(R, Col1).Value * 100
        For Col = RRuota To RRP
            If Cells(R, Col1).Value = Cells(R, Col).Value Then GoTo salta
             If Col > XCF Then GoTo salta
            AmboE = AA + Cells(R, Col).Value
            If AmboE = Ambo Then
                Cells(R, Col).Select
                With Selection.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
                End With
                Selection.Font.ColorIndex = 2

                Cells(R, Col1).Select
                With Selection.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
                End With
                Selection.Font.ColorIndex = 2

                If MR = 0 Then
                    MTRAMBO = R - 8
                    RATT = R - 8
                End If
                MR = 1
                MRAMBO = R - RAMBO - 8
                If RAMBO = 0 Then RAMBO = MRAMBO
                If RAMBO < MRAMBO Then RAMBO = MRAMBO - 1
                Freq = Freq + 1
                MTRAMBO = R - 8
            End If
salta:
        Next
    Next
Next
If RATT = "" Then RATT = Ue - 7
Worksheets("Archivio").Range("J3").Value = RATT
If MRAMBO = "" Then MRAMBO = -1
If Ue - MTRAMBO - 8 > RAMBO Then RAMBO = Ue - MTRAMBO - 8
Worksheets("Archivio").Range("I3").Value = RAMBO
Worksheets("Archivio").Range("K3").Value = Freq
Worksheets("Archivio").Range("I1").Value = NomeR
Worksheets("Archivio").Range("E3").Select
End Sub

Sub CercaAutomArch()
MFreq = 0
Application.ScreenUpdating = True
Application.ScreenUpdating = Default
Application.ScreenUpdating = False
Application.Calculation = xlManual
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
    Worksheets("Archivio").Select
Ue = Worksheets("Archivio").Range("C" & Rows.Count).End(xlUp).Row
For I = 1 To 89
        Application.StatusBar = "Elaborazione Max Freq Ambo su " & NomeR & " ... " & Int(I / 90 * 100) & " %"
        With Worksheets("Archivio").Range(Cells(8, RRuota), Cells(Ue, RRP))
            Set C = .Find(I, LookIn:=xlValues)
            If Not C Is Nothing Then
                firstAddress = C.Address
                Do
                    If C.Value = I Then
                    Riga = C.Row
                    Call CercaB
                    End If
                    Set C = .FindNext(C)
                    'On Error Resume Next
                Loop While Not C Is Nothing And C.Address = firstAddress
                    'On Error GoTo 0
            End If
        End With
Next
Call CercaAmbo
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = oldStatusBar
Application.DisplayStatusBar = False

End Sub
Sub CercaB()
    For B = I + 1 To 90
    Freq = 0
       With Worksheets("Archivio").Range(Cells(Riga, RRuota), Cells(Riga, RRP))
            Set D = .Find(B, LookIn:=xlValues)
            If Not D Is Nothing Then
                firstDAddress = D.Address
                Do
                    If D.Value = B Then
                    AmboAut = I * 100 + B
                    Call CercaAmboA
                        'Freq = Freq + 1
                    End If
                    Set D = .FindNext(D)
                    On Error Resume Next
                Loop While Not D Is Nothing And D.Address <> firstDAddress
                    On Error GoTo 0
            End If
        End With
    Next
End Sub
Sub CercaAmboA()
For R = 8 To Ue
    For Col1 = RRuota To RRP
        AA = Cells(R, Col1).Value * 100
        For Col = RRuota To RRP
        If Cells(R, Col1).Value = Cells(R, Col).Value Then GoTo salta
        'Freq = 0
        AmboE = AA + Cells(R, Col).Value
        If AmboE = AmboAut Then Freq = Freq + 1
        If Freq > MFreq Then
            MFreq = Freq
            MAmboAut = AmboAut
        End If
salta:
        Next
    Next
Next
Worksheets("Archivio").Range("B3").Value = MAmboAut
End Sub

Ora potrai cancellare il foglio Ritardi_Ambo anzi visto che il file si è talmente ridotto lo allego per maggior chiarezza e per dare a tutti la possibilità di utilizzarlo.
Ciao
P.s.
1) I tempi in Automatico sono notevolmente migliorati solo 13 secondi (ruota) contro i 90 della versione precedente ;)
2) Devo ancora intervenire sul pulsante "T" (Tutte le Ruote) in quanto non mi risulta facile scansionare un'area di 55 colonne suddivise in 11 sezioni (da 5 colonne cad) per determinare l'ambo-ruota ma sicuramente qualche volontario potrà darci una mano
Allegati

[L’estensione zip è stata disattivata e non puó essere visualizzata.]

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-

Sponsor
 

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi biancocandido55 » 14/05/09 17:16

Ciao Flash,
noto con piacere che i miei spunti (non spuntini :lol: :lol: ), hanno animato una certa fame di programmazione, sono veramente strabiliato da cosa si può arrivare a fare imparando il vba, certamente ci vuole tempo e anche una certa fatica di meningi, non ci sono parole che si possano esprimere, è veramente un gran bel programma.
Ho visto che hai remmato qualche riga del programma, scommetto che stai già pensando di ampliarlo con qualche altra chicca?? ;) :D
Ho caricato anche le estrazioni dal 1871 ad oggi, i tempi di elaborazione da quello che dici non sono cambiati se non di qualche decimo di sec.
Confido anch'io sull'iintervento di altri che vogliano intervenire.
Come sempre un abbraccio, e GRAZIE a pré
ciao biancocandido
biancocandido55
Utente Senior
 
Post: 305
Iscritto il: 03/03/06 10:15

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 14/05/09 19:54

Ecco!
Ora è più o meno terminato
Le funzioni sono le stesse ma ogni ruota ha i suoi risultati.

Il problema del Range per tutte le ruote alla fine l'ho risolto con un semplice for next da 1 a 11 in pratica fa 11 volte la scansione dalla riga 8 alla riga n limitando a sole 5 colonne alla volta ma... è meglio che alleghi il file

ciao
Allegati

[L’estensione zip è stata disattivata e non puó essere visualizzata.]

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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi biancocandido55 » 15/05/09 08:14

Ciao Flash,
Flash dice: Ecco! Ora è più o meno terminato.
.
Lo sapevo che mancava l'ennesima chicca :D :lol: ,
Flash, per quello che mi riguarda, sono al massimo 8) ,
grazie come sempre.
ciao
biancocandido
biancocandido55
Utente Senior
 
Post: 305
Iscritto il: 03/03/06 10:15

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 15/05/09 10:11

Speriamo di aver accontentato anche qualche altro appassionato di statistiche del lotto.

Per utilizzare quel programma è necessario (per chi non ha seguito il topic) di un piccolo e semplice tutorial.

Se in A1 c'è la lettera "A" il programma va in automatico e cerca l'ambo più frerquente
di ruota se cliccate due volte sulla testata ruota (BARI, CAGLIARI etc)
mentre se si clicca (due volte) sulla lettera "T" (B6) il programma eseguirà la scansione di tutte le ruote ed evidenzierà l'ambo più frequente su ciascuna ruota con ritardo massimo (Storico) MS o attuale RA.
Se in A1 non c'è nulla o "M" (per comodità e promemoria: Manuale) il programma ricerca l'ambo digitato nella cella B3 tenendo presente che il primo numero è moltiplicato per 100 e il secondo numero è addizionato quindi per cercare l'ambo composto da 1 e 65 si dovrà digitare 165 oppure 2503 per cercare l'ambo 25 e 3. E' possibile utilizzare questa ricerca sia per singola ruota che per tutte come descritto sopra.

Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 18/06/09 08:45

Salve,è possibile avere il file di questo topic? vi sarei grado grazie in anticipo .Saluti Aldo
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 18/06/09 09:14

aldoxx ha scritto:Salve,è possibile avere il file di questo topic?


Puoi scaricarlo qui

Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 18/06/09 10:18

Grazie mille !! ti chiedo solo un piacere è possibile modificare con l'archivio che parte in ordine al contrario
esempio, impostando l'archivio che parte da :
21/08/08
23/08/08
26/08/08
28/08/08
ecc.
Ti ringrazio della disponibilità !!
saluti Aldo
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 18/06/09 23:12

Per come è strutturata la macro non si può fare, bisognerebbe farla ex-novo però, può esserti utile questa macro che permette al tuo archivio ("rovesciato" rispetto al programma) di metterlo nello stesso ordine adatto alla macro
devi solo rinominare il tuo foglio in Archivio1 all'interno della stessa cartella del file che hai scaricato.
Ultima raccomandazione i dati del tuo archivio (foglio Archivio1) devono iniziare dalla riga 8
copia e incolla nel modulo questo codice
Codice: Seleziona tutto
Sub Macro1()
Rov = Worksheets("Archivio1").Range("C" & Rows.Count).End(xlUp).Row
For I = 8 To Rov
    Sheets("Archivio1").Select
    Rows(I & ":" & I).Select
    Selection.Copy
    Sheets("Archivio").Select
    Rows(Rov & ":" & Rov).Select
    ActiveSheet.Paste
    Rov = Rov - 1
Next
End Sub

Esegui la macro e avrai i tuoi dati perfettamente allineati per essere processati

Ciao

P.S L'utente che ha richiesto il programma copiava i dati da pagine web e li trovava già in ordine decrescente e credo che abbia inviato, in un post di questo topic, il link per attingere ai dati
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 19/06/09 10:39

Ciao, flash grazie della tua gentilezza, se non ti scoccio me lo potresti modificare perche io ho l'archivio impostato in quel modo quindi gia uso le mie ricerche sulle mie estrazioni.... modificando come dici tu, dovrei cambiare tutto il mio programmino ..ti sarei davvero grado se me lo modifichi, grazie in aticipo e scusa la mia insisteza .
Saluti Aldo
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 19/06/09 13:13

aldoxx ha scritto:... potresti modificare perche io ho l'archivio impostato in quel modo quindi gia uso le mie ricerche sulle mie estrazioni.... modificando come dici tu, dovrei cambiare tutto il mio programmino ..ti sarei davvero grado se me lo modifichi, grazie in aticipo e scusa la mia insisteza


Allora se leggi dal primo post (Aprile 2009) e il post delll'ultima soluzione (maggio 2009) è occorso un mese...
Non vedo la difficoltà ad avere eventualmente un foglio in più (?)
Dimmi come si chiama il foglio del tuo archivio e come è formattato (dove iniziano i dati) semmai manda un'immagine.
Io provvederò a crearti un foglio con l'archivio adatto ad essere processato con il programma perché solo così abbreviamo i tempi e eviteremo spreco di energie inutili.

Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 19/06/09 15:05

ecco il file grazie in aticipo
saluti Aldo
http://rapidshare.com/files/246290490/arcvioAldo.xls.html
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 19/06/09 20:08

Forse mi sono espresso male, io intendevo dire di mandarmi un'immagine del tuo archivio (quello dove hai i tuoi programmini) perché avrei fatto in modo di crearti un foglio nuovo (preso dal tuo archivio) ma che possa funzionare con la macro già postata, quindi ribaltando, in questo foglio nuovo, l'ordine del tuo archivio.
Avrai, così, la possibilità di usare il foglio del tuo archivio (non credo si chiami Foglio1, come quello che mi hai inviato) per i tuoi programmi e questo nuovo foglio per il programma già esistente.
Che ne pensi?

Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 19/06/09 22:33

ok hai ragione il foglio1 puoi mettere il nome archivio perche cosi è il mio archivio grazie della attenzione. ;)
salti Aldo
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 19/06/09 23:53

ok scarica questo file
http://rapidshare.com/files/246447717/a ... o.rar.html

aggiungi tutti i tuoi fogli in questa cartella e i tuoi programmi all'interno del modulo (per maggior chiarezza aggiungi un modulo)

Fai sapere se ok
Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 20/06/09 09:27

Ciao flash , il programma che hai fatto va bene, ma non era possibile fare ch'elabora normalmente invece difare cosi?
io sono abbituato con l'archivio che parte da su al ingù com ti avevo accennato grazie per l'interessamento saluti Aldo.
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Anthony47 » 20/06/09 16:36

Pero' rigirare i dati non dovrebbe essere un problema, basta fare un ordinamento per colonna "Data" o "numero di estrazione"; o no??
D' altra parte per utilizzare lavori gia' fatti talvolta bisogna fare qualche piccolo adattamento...

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

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 21/06/09 10:09

Anthony , hai ragone sul fatto dei dati e del adattamento del file , era solo un piacere comuque grazie della disponobilità ;)
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Re: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi Flash30005 » 21/06/09 10:21

aldoxx ha scritto:Anthony , hai ragone sul fatto dei dati e del adattamento del file , era solo un piacere comuque grazie della disponobilità ;)


Vedi Aldoxx,
Il tuo archivio non è affatto compatibile come formattazione, non ha una testata dove vengono messi i risultati per ruota, ambo di ricerca etc.
Come avrai notato nel foglio ArchivioPrg le prime 7 righe sono occupate dalla testata necessaria per la distribuzione dei risultati, nel tuo archivio questa testata manca, dove dovrei mettere quei dati?
se aggiungo le righe sul tuo archvio penso che non funzionerebbero ugualmente i tuoi programmini che già hai, quindi, siamo di nuovo nei pasticci.
Inoltre, come accennavo in un post precedente significa rifare ex-novo l'intero programma che comporterebbe diverse ore di lavoro (non è così semplice come sembra, viste le funzioni), sto pensando, invece, che forse, sarebbe più semplice modificare i tuoi programmi per adattarli al foglio ArchivioPrg, semmai posta il tuo file con le macro così potrò valutare cosa conviene fare.

Ciao
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: [Excel] Repetite Iuvant.........Ritardi ambo()

Postdi aldoxx » 21/06/09 15:49

Flash, grazie sei una persona davvero altruista e molto gentile non preucuparti mi adatterò.. .
grazie di nuovo
saluti Aldo
aldoxx
Newbie
 
Post: 8
Iscritto il: 17/06/09 21:05

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "[Excel] Repetite Iuvant.........Ritardi ambo()":


Chi c’è in linea

Visitano il forum: Nessuno e 58 ospiti