Condividi:        

Identificare record ripetuti

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: Identificare record ripetuti

Postdi Lucio P. » 29/04/09 01:41

Non ho ben afferrato in quale posizione aggiungere la seconda modifica

Application.ScreenUpdating = True '<<< E QUESTA
End Sub
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Sponsor
 

Re: Identificare record ripetuti

Postdi Lucio P. » 29/04/09 06:35

Lucio P. ha scritto: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
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Re: Identificare record ripetuti

Postdi Anthony47 » 29/04/09 13:23

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.
Avatar utente
Anthony47
Moderatore
 
Post: 19182
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Identificare record ripetuti

Postdi Lucio P. » 29/04/09 13:40

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 :P
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Re: Identificare record ripetuti

Postdi Lucio P. » 30/04/09 14:55

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? :cry:

Immagine


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.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Re: Identificare record ripetuti

Postdi Lucio P. » 30/04/09 18:11

Lucio P. ha scritto: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? :cry:

Immagine


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.
Lucio P.
Utente Junior
 
Post: 82
Iscritto il: 15/04/09 08:53

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Identificare record ripetuti":


Chi c’è in linea

Visitano il forum: Anthony47 e 25 ospiti