Identificare record ripetuti

[Lucio P.]

Non ho ben afferrato in quale posizione aggiungere la seconda modifica

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

[Lucio P.]

Non ho ben afferrato in quale posizione aggiungere la seconda modifica

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

Ciao Anthony, stanotte ha girato tre ore di seguito e mi ha svolto un buon 25% del lavoro (90.000 record in tre ore).
La macro gira benissimo, indubbiamente ha acquisito anche in velocità. Avevo poi afferrato, dove inserire la seconda modifica.
Per la verità quando l’ho fatta partire, prima di riuscire a capire cosa volevi dire per (schermo congelato), ho dovuto interromperla perché mi sembrava non funzionare; non dava segni di vita ma in realtà stava svolgendo il suo compito.
Un plauso, dunque, per questo ennesimo aiuto.

Saluti, Lucio

[Anthony47]

CREDO DI AVER CAPITO perche' a volte va (sembra che vada) in loop...
Avendo definito le variabili BA, CA, FI etc come "statiche", quando rilanci la macro troverai sicuramente alcune variabili gia' inizializzate (a 1), quindi non riuscirai piu' a creare delle "decine" (o novine e cinquine in altre versioni della macro) e ti saranno cancellati tutti i record successivi ai primi N (9>N>1).
Per evitare cio', aggiungi in testa alla macro l' istruzione marcata <<<<:

Codice: Seleziona tutto

    Ur = Range("A" & Rows.Count).End(xlUp).Row
    BA = 0: CA = 0: FI = 0: GE = 0: MI = 0: NA = 0: PA = 0: RO = 0: TOR = 0: VE = 0   '<<<<<<
    Ruote = 0


Le istruzioni prima e dopo servono per la conferma della posizione).

Ciao.

[Lucio P.]

Ciao Anthony, in nove ore ha fatto due terzi del lavoro cioè 270.000 record; direi che è proprio un record!
Aggiungo ancora questa modifica e penso, ancora un tre ore e anche questa ricerca sia semifinita; il rimanente è compito mio.
Ancora grazie, Lucio

[Lucio P.]

Ciao da Lucio,
non vorrei sembrare seccante ma, purtroppo quando si ha bisogno del medico bisogna a lui rivolgersi; in questo caso siete voi.

Si può fare questa modifica o aggiunta?

Codice: Seleziona tutto

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

'Ur = Range("A65536").End(xlUp).Row
Ruote = 0
I = 2
While I <= Ur
If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA
'Ruote = 9: I = I - 1: GoTo NewN '<<< Aggiunta
Ruote = 9: I = I - 1: PLM = 1: GoTo NewN '<<< Aggiunta                    +A+A+A+A   aggiunto PLM
End If

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

    If Ruote = 9 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, 5) = Cells(I, 3) - Cells(I - 1, 3)   '<<<< +++++ +A+A+A+A  Modificata, era If I>7

            'If I > 7 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3)    '<<<< +++++
        End If
        PLM = 0
            I = I + 1
    '    OldN = Cells(I, 1)  '<<< ******Aggiunta   MODIFICATA, cioe' tolta
    Wend



End Sub

[Lucio P.]

Ciao da Lucio,
non vorrei sembrare seccante ma, purtroppo quando si ha bisogno del medico bisogna a lui rivolgersi; in questo caso siete voi.

Si può fare questa modifica o aggiunta?

Codice: Seleziona tutto

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

'Ur = Range("A65536").End(xlUp).Row
Ruote = 0
I = 2
While I <= Ur
If OldN <> Cells(I, 1) And OldN <> "" Then '<<< *****Aggiunta MODIFICATA
'Ruote = 9: I = I - 1: GoTo NewN '<<< Aggiunta
Ruote = 9: I = I - 1: PLM = 1: GoTo NewN '<<< Aggiunta                    +A+A+A+A   aggiunto PLM
End If

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

    If Ruote = 9 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, 5) = Cells(I, 3) - Cells(I - 1, 3)   '<<<< +++++ +A+A+A+A  Modificata, era If I>7

            'If I > 7 Then Cells(I, 5) = Cells(I, 3) - Cells(I - 1, 3)    '<<<< +++++
        End If
        PLM = 0
            I = I + 1
    '    OldN = Cells(I, 1)  '<<< ******Aggiunta   MODIFICATA, cioe' tolta
    Wend



End Sub

Piccolo accorgimento: In pratica, ogni numero della colonna "A" si conclude con un solo ciclo di nove; tutti gli altri devono essere eliminati. In questo caso il 68 cotiene, come ogni numero, minimo un centinaio di cicli; percui fatta la scansione e ottenuto il primo, gli devono essere eliminati.