Cancellare righe doppioni in tabella

Hai un problema con Excel?

Nuova discussione

Cancellare righe doppioni in tabella
di Fra2309 (utente non iscritto) data: 29/11/2012 11:46:22
Salve a tutti
Devo creare una macro che mi formatti una tabella e mi cancelli le righe doppione, mantenedomi quella più aggiornata, che si trova cioè più in basso in tabella. La macro sfrutta due campi come chiave univoca, chiamati "SO" e "NP JOB #" che si trovano rispettivamente nella colonna 11 e 12. In sostanza se due righe hano lo stesso "SO" oppure lo stesso "NP JOB #" devono considerarsi doppioni e la prima (quella più inm alto in tabella, deve essere eliminata)...Per fare girare la macro su una tabella diversa state attenti a cambiare gli indici 11 e 12 in base a dove mettete i vostri campi univoci... Poi un'altra condizione che deve controllare è il campo della colonna 2. Infatti se due righe hanno lo stesso SO, per poterle considerare uguali deve vedere se è uguale il valore anche nella colonna 2 a cui corrisponde un campo chiamato "Line Number". Se due righe con stesso SO hanno doverso Line Number, allora NON sono doppioni...
Ultima complicazione: Nel cancellare la riga doppione più vecchia, comunque devono essere mantenuti quei campi che magari nella riga equivalente meno vecchia non sono presenti e esere copiati in quest'ultima ovviamente.
Il codice che ho scritto fa esattamente questo...il problema è che dovendo lavorare con tabelle ESTREMAMENTE GRANDI ci mette una vita perchè si scorre riga per riga!...come posso ottenere lo stesso risultato aumentando le performance? Usando per esempio gli Array? Come si fa?

Grazie mille!

Sub FormattaTabella()
Dim lastRow As Integer
Dim RigaTest As Integer
Dim lastColumn As Long
Dim rng As Range
Dim ColonnaTest As Integer
Dim RigaCancellata As Boolean

Application.ScreenUpdating = False

Range("A2").Select
Set rng = ActiveSheet.UsedRange
lastRow = rng(rng.Count).Row
lastColumn = rng(rng.Count).Column
'lastRow = Cells(Rows.Count, "A").End(xlUp).Row
'lastColumn = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 2 To lastRow
'Do While ActiveCell.Value <> ""

'ogni "CodiceFiscale" (i) verrà confrontato con tutti gli altri (j)
If Cells(i, 11).Value <> "" Then ColonnaTest = Cells(i, 11).Column
If Cells(i, 12).Value <> "" Then ColonnaTest = Cells(i, 12).Column
RigaTest = Cells(i, ColonnaTest).Row

    For j = 2 To lastRow
    Cells(j, ColonnaTest).Select
    If Cells(i, ColonnaTest).Value = Cells(j, ColonnaTest).Value And Cells(j, ColonnaTest).Row <> RigaTest And Cells(i, 2).Value = Cells(j, 2).Value Then
    'If ActiveCell.Value = Cells(j, 1).Value And Cells(j, 1).Row <> CellaTest Then
    For k = 1 To lastColumn
    'Cells(i, k).Font.Bold = True
    Cells(j, k).Select
        If Cells(i, k).Value <> Cells(j, k).Value And Cells(j, k).Value = "" Then
        Cells(i, k).Copy Destination:=ActiveSheet.Cells(j, k)
        End If
        Next k
   Cells(i, 1).EntireRow.Delete
   i = i - 1
   'If RigaCancellata = True Then Exit For
   'esce dal FOR j
    Exit For
'Else
'If Cells(j, ColonnaTest).Value = "" Then Exit For
    End If
    'If Cells(j, 1).Row > CellaTest Then Exit For
    Next j
    'esce dal FOR i
    If Cells(i + 1, 11).Value = "" And Cells(i + 1, 12).Value = "" Then Exit For
    'ActiveCell.Offset(1, 0).Select
'Loop

Next i
End Sub

di Vecchio Frac data: 29/11/2012 20:43:54
Per velocizzare un po' puoi togliere tutti i .Select: non ti serve affatto selezionare una cella per controllarne il valore, visto che non usi mai ActiveCell (e giustamente!) ma controlli il valore di una cella direttamente con Cells(..., ...).
Per il resto, forse bisognerebbe ripensare l'algoritmo. Non è detto che appena terminato questo periodo di superlavoro non mi ritorni in mente di rivedere questo quesito :)

Vuoi Approfondire?