RemoveDuplicates

Hai un problema con Excel?

Nuova discussione

RemoveDuplicates
di Olimpico (utente non iscritto) data: 26/12/2013 17:21:41
Ciao a tutti!! vi descrivo il mio problema! :) Ho due fogli (sheet1 e sheet2) quasi identici e una chiave primaria in colonna (A) che è un codice alfanumerico. Parliamo di circa 20000 righe. Io vorrei controllare questo codice tra i due fogli e vedere quali sono i codici dello sheet1 che non presenti nel mio sheet2. questa situazione per me vorrebbe dire che si è aggiunto un nuovo prodotto con codice Ai.
Problemi:
1) le righe di codice che ho scritto sotto sono lentissime!
2) Non si tratta di una vera e propria chiave primaria perché la colonna A presenta una marea di duplicati. Io vorrei escluderli dalla ricerca e controllare univocamente ogni codice. Credo che ciò potrebbe velocizzare parecchio il mio codice.
Grazie mille per le vostre idee e suggerimenti

    For Each Cella In Area2
       Nome = Cella
       Set Riga = Area1.Find(Nome, LookIn:=xlValues, LookAt:=xlWhole)
       If Riga Is Nothing Then
           ws3.Cells(R, 8) = Cella
           ws3.Cells(R, 9) = "Nuovo Prodotto"
           R = R + 1
       End If
    Next Cella

di patel data: 26/12/2013 17:33:23
potresti utilizzare la funzione Dati, Rimuovi Duplicati prima di lanciare la macro
di gaetanopr (utente non iscritto) data: 26/12/2013 17:34:28
Se puoi allega un file di esempio che rispecchi l'originale
di Olimpico (utente non iscritto) data: 26/12/2013 17:43:01
Ciao Grazie della vostra risposta. Quella di patel è una soluzione che ho già implementato però vorrei lasciare i due fogli puliti.
Ciò che avevo pensato, ma magari è una cosa non fattibile, è di rimuovere i duplicati direttamente in Area1 e Area2 che sono i due miei range sui due sheet. Però non so se è possibile farlo. Cosa ne pensate?
di patel data: 26/12/2013 18:14:33
se non ti decidi ad allegare un esempio (non 20000 righe, ma 100) c'è poco da pensare
di Olimpico (utente non iscritto) data: 26/12/2013 18:47:42
Eccolo pardon! :) Come puoi vedere a me non interessa il campo prezzo ma soltanto in questo caso "AATMY" - bolls perchè è l'unico prodotto che non avevo al 251210..grazie

di gaetanopr data: 26/12/2013 19:19:53
Prova questa macro

Sub Rimuovi()
Set ws3 = Sheets("261213")
Set ws1 = Sheets("251210")
ur = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
ur2 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Set Area2 = Sheets("251210").Range("A1:A" & ur2)

Range("A1:A" & ur).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set Area1 = ws3.Range("A1:A" & ur).SpecialCells(xlCellTypeVisible)

 For Each Cella In Area1
       Nome = Cella
       Set Riga = Area2.Find(Nome, LookIn:=xlValues, LookAt:=xlWhole)
       If Riga Is Nothing Then
           R = R + 1
           ws3.Cells(R, 8) = Cella
           ws3.Cells(R, 9) = "Nuovo Prodotto"
           
       End If
    Next Cella
    If ws3.FilterMode Then
       ws3.ShowAllData
    End If
    
 Set ws1 = Nothing
 Set ws3 = Nothing
 Set Area1 = Nothing
 Set Area2 = Nothing
    
End Sub

di gaetanopr data: 26/12/2013 19:30:05
Oppure in questo modo

Sub RimuoviCountif()
Set ws3 = Sheets("261213")
Set ws1 = Sheets("251210")
ur = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row
ur2 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Set Area2 = ws1.Range("A1:A" & ur2)

Range("A1:A" & ur).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set Area1 = ws3.Range("A1:A" & ur).SpecialCells(xlCellTypeVisible)

 For Each Cella In Area1
       Nome = Cella
       If Application.CountIf(Area2, Cella) = 0 Then
           R = R + 1
           ws3.Cells(R, 8) = Cella
           ws3.Cells(R, 9) = "Nuovo Prodotto"
           
       End If
    Next Cella
    If ws3.FilterMode Then
       ws3.ShowAllData
    End If
    
 Set ws1 = Nothing
 Set ws3 = Nothing
 Set Area1 = Nothing
 Set Area2 = Nothing

End Sub

di gaetanopr data: 26/12/2013 19:31:33
Questa parte si può eliminare
Nome = Cella
di gaetanopr data: 26/12/2013 19:49:45
Ho allegato il file con le due macro, ho modificato un pò le macro
di Olimpico (utente non iscritto) data: 26/12/2013 20:57:32
Wao! Grande :) adesso la provo subito!! Grazie mille..!
di Olimpico (utente non iscritto) data: 27/12/2013 16:38:53
Grazie mille funziona tutto! :)

Vuoi Approfondire?