Identificare record ripetuti

[Lucio P.]

In realtà, quest'aggiunta indica che il ciclo di nove è terminato e fintanto che non cambia numero essa procede nel modo corretto. Però quando si passa da un numero all'altro difficilmente ci troveremo con ciclo di nove terminato percui, in questo caso non dovrebbe essere segnalato o per meglio dire, non deve sottrarre alcun che perchè il ciclo non è completo.
Spero di aver chiarito ma se così non fosse, dimmelo. Ciao Lucio

[Anthony47]

Nella descrizione precedente non era chiaro che si doveva escludere il calcolo nei casi in cui il ciclo non era arrivato a 9; e purtroppo l' esempio allegato cambiava numero sempre in corrispondenza di una "novina".
Prova queste modifiche (identificate con +A+A+A+A+A):

Codice: Seleziona tutto

If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA
Ruote = 9: I = I - 1: PLM=1 :GoTo NewN '<<< Aggiunta                    +A+A+A+A   aggiunto PLM
End If


Codice: Seleziona tutto

OldN = Cells(I + 1, 1)    '*******<<<< AGGIUNTA AGGIUNTA
If PLM = 0 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3)   '<<<< +++++ +A+A+A+A  Modificata, era If I>7
End If
PLM = 0                                 '<<<<<< +A+A+A+A+A Aggiunta
I = I + 1


Ciao.

[Lucio P.]

Ciao Anthony, funziona alla perfezione.
Grazie infinite, Lucio

[Lucio P.]

Si può fare con il tempo dovuto?

[Anthony47]

Secondo me lo puoi fare in proprio.
Nella macro che hai modifichi la parte Select case, sostituendo i primi 5 Case "XX" con Case "To-Ve", Case "Ba-Ca" o quelli che sono; puoi lasciare invariate le altre istruzioni tra Select Case ed End Select.
Dovrai poi modificare tutte le istruzioni che fanno riferimento al valore 9 di Ruote senza alterarne il contesto; quindi non Ruote=9 e If Ruote=9, ma Ruote=5 e If Ruote=5.
Lascia pure le istruzioni Case "xx" che non modifichi, non daranno fastidio...

Prova, vedrai che funziona; ma prova sempre dopo aver fatto due copie di backup dei tuoi file.

Ciao.

[Lucio P.]

Select Case Cells(I, 2)
Case "Ba-Ca"
If BA = 1 Then
Cancella_Doppione I, Ur
Else
BA = 1
Ruote = Ruote + 1
End If

Ciao Anthony, suppongo debba cambiare anche If Ba con "Ba-Ca"
e sotto Else idem?

[Anthony47]

No, le altre vanno bene anche cosi'.
Che si chiami (la variabile) Ba, Ba-Ca, pippo, o quant'altro, sempre quella cosa conta.

Ciao.

[Lucio P.]

Risolto anche questa, grazie.

[Lucio P.]

Buona serata gentilmente è possibile?

Si tratta di modificare la solita macro non più con cinque Bi-Ruote ma nove, in altre parole:
Nella prima macro si chiudeva un ciclo ogni otto record, esso escludeva le ruote doppione.
Nella seconda macro abbiamo accorciato il ciclo a cinque, esso escludeva le bi-ruote doppione.
Questa terza modifica contiene nove bi-ruote consecutive e chiude il ciclo non più a otto ma nove.

Come sempre ringrazio chi vuole cimentarsi con questo tema interessante da un punto di vista statistico che riguarda la materia “lotto”.

[Lucio P.]

Ci ho provato ma la macro mi si blocca; dov'è l'errore?

In pratica, come da immagine inserita, dovrebbe eliminare le ruote doppione e alla decima ruota dovrebbe sottrarre per l'appunto la decima meno la nona.

Grazie per l'attenzione, Lucio

Codice: Seleziona tutto

Dim I As Integer, Ruote As Integer, Ur As Single
Dim BA As Integer, CA As Integer, FI As Integer, GE As Integer, MI As Integer
Dim NA As Integer, PA As Integer, RO As Integer, TOR As Integer, VE As Integer

Sub Lucio()
Ur = Range("A" & Rows.Count).End(xlUp).Row


Ruote = 0
I = 2
While I <= Ur
If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA

Ruote = 10: I = I - 1: PLM = 1: GoTo NewN '<<< Aggiunta                    +A+A+A+A   aggiunto PLM
End If

    Select Case Cells(I, 2)
        Case "Ba-Ca"
            If BA = 1 Then
                Cancella_Doppione I, Ur
            Else
                BA = 1
                Ruote = Ruote + 1
            End If
        Case "Ca-Fi"
            If CA = 1 Then
                Cancella_Doppione I, Ur
            Else
                CA = 1
                Ruote = Ruote + 1
            End If
        Case "Fi-Ge"
            If FI = 1 Then
                Cancella_Doppione I, Ur
            Else
                FI = 1
                Ruote = Ruote + 1
            End If
        Case "Ge-Mi"
            If GE = 1 Then
                Cancella_Doppione I, Ur
            Else
                GE = 1
                Ruote = Ruote + 1
            End If
        Case "Mi-Na"
            If MI = 1 Then
                Cancella_Doppione I, Ur
            Else
                MI = 1
                Ruote = Ruote + 1
            End If
        Case "Na-Pa"
            If NA = 1 Then
                Cancella_Doppione I, Ur
            Else
                NA = 1
                Ruote = Ruote + 1
            End If
        Case "Pa-Ro"
            If PA = 1 Then
                Cancella_Doppione I, Ur
            Else
                PA = 1
                Ruote = Ruote + 1
            End If
        Case "Ro-To"
            If RO = 1 Then
                Cancella_Doppione I, Ur
            Else
                RO = 1
                Ruote = Ruote + 1
            End If
        Case "To-Ve"
            If TOR = 1 Then
                Cancella_Doppione I, Ur
            Else
                TOR = 1
                Ruote = Ruote + 1
            End If
        Case "Ve-Ba"
            If VE = 1 Then
                Cancella_Doppione I, Ur
            Else
                VE = 1
                Ruote = Ruote + 1
            End If
    End Select
NewN:                      '<<< Aggiunta

    If Ruote = 10 Then
BA = 0: CA = 0: FI = 0: GE = 0: MI = 0: NA = 0: PA = 0: RO = 0: TOR = 0: VE = 0
                   Ruote = 0
            OldN = Cells(I + 1, 1)    '*******<<<< AGGIUNTA AGGIUNTA
            If PLM = 0 Then Cells(I, 10) = Cells(I, 3) - Cells(I - 1, 3)   '<<<< +++++ +A+A+A+A  Modificata, era If I>7

           
        End If
        PLM = 0
            I = I + 1
   
    Wend



End Sub

Sub Cancella_Doppione(I, Ur)
    Rows(I).Select
    Selection.Delete Shift:=xlUp
    Ur = Ur - 1
    I = I - 1
End Sub



[Anthony47]

Con quali sintomi "si blocca"? errore di compilazione? errore quando la lanci? va in loop? si completa ma non esegue...

Ciao.

[Lucio P.]

Ciao Anthony, credo che vada in loop. Si ferma subito su una riga senza e sembra che pur continuando a scansionare in realtà non va avanti.

[Anthony47]

Hum... se hai piu' di 30mila record cambia, in testa Dim I As Integer in

Codice: Seleziona tutto

Dim I As Single, Ruote etc etc


Ciao.

[Lucio P.]

Chiedo venia, in realtà nella macro ho agginto una bi-ruota (Ve-Ba)l'ultima. Quindi le bi-ruote in questione sono dieci e non nove come da immagine; da qui, arrivati per l'appunto alla decima bi-ruota, si fa la solita sottrazione dalla decima alla nona.
Saluti

[Anthony47]

Questo l' avevo visto, ma mi pare che nella macro hai compilato bene; quante righe hai?

Ciao.

[Lucio P.]

Per prova ne ho messe 500 e come detto inizia e si pianta su una riga; è come se si piantasse laddove deve sottrarre la decima ruota meno la nona. Per quanto riguarda le dim, effettivamente si fermava all'incirca sulle trentunomilarighe. Non era un grosso problema che penso ora sia risolto, proverò.
Quello che conta è adesso.
Saluti

[Anthony47]

Mentre e' in loop premi Esc e vai in debug; poi premi F8 un po' di volte e dimmi su quali istruzioni cicla.
Metti il cursore su "Ruote" in If Ruote = 10 Then (senza cliccare) e dimmi che numerello esce dopo qualche secondo.

Ciao.

[Lucio P.]

D'incanto si è messa in funzione, bhoo!
Fa quello che deve, l'unica cosa (ci impiegherò un paio di giorni prima che finisca).
La scansione è molto lenta, probabilmente dovuto al fatto che ci sono dentro 400.000 record.
Pensi che possano esservi altri motivi?
Ciao, Lucio

[Anthony47]

Riavvia il pc...
Per ulteriormente velocizzare la macro puoi aggiungere queste:

Codice: Seleziona tutto

Sub Lucio()
Application.ScreenUpdating = False     '<<< QUESTA

e poi

Codice: Seleziona tutto

Application.ScreenUpdating = True     '<<< E QUESTA
End Sub

Il lato negativo e' che lo schermo si congela durante l' elaborazione, nemmeno ti accorgi se si muove.

Ciao.

[Lucio P.]

Ok e grazie.
Faccio le dovute modifiche e stanotte lo lascio girare.
Domani ti faccio sapere, buona notte o buona giornata.
Ciao Lucio