vba2003:cercare e cancellare tutte le righe con codice=

[karug64]

Salve a tutti.
Ho un foglio che viene alimentato giornalmente da una routine con dati esterni di dimensioni sempre piu' grandi.
Il foglio non puo' essere ordinato ma deve rimanere cosi' com'e'.
Il foglio contiene in colonna A il codice cliente.
Mi interesserebbe una routine che, iniziando dall'ultimo dato inserito (dalla fine del foglio), mi individui tutti le righe che contengono nella colonna A lo stesso codice e me le cancelli.
Mi interessa che l'ordine seguito sia proprio questo (dall'ultimo) perche' man mano che il file si alimenta le ultime righe contengono dati piu' aggiornati a discapito di quelli piu' obsoleti delle prime righe.

Quindi se :

A1-1-antonio
A2-2-francesco
A3-30-carlo
A4-1-antonio
A5-4-giulio
A6-31-lucio
A7-2-francesco
A8-5-franco

alla fine dovrei avere

A1-30-carlo
A2-1-antonio
A3-4-giulio
A4-31-lucio
A5-2-francesco
A6-5-franco

Grazie

[karug64]

Avrei trovato questa elemtare soluzione :

Codice: Seleziona tutto

ur = Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Row
   
    For x = ur To 2 Step -1
        For y = x - 1 To 2 Step -1
            If Len(Trim(Cells(x, 1))) <> 0 Then
                If Cells(x, 1) = Cells(y, 1) Then
                    Sheets("Riepilogo").Range(Cells(y, 1), Cells(y, 6)).Delete
                End If
            End If
        Next y
    Next x


ma e' di una lentezza esasperante (il foglio contiene circa 4.000 righe in costante aumento).
Non e' che ci sarebbe un metodo per velocizzare il tutto ?
Grazie

[ricky53]

Ciao,
utilizza una ARRAY, caricala con i dati del tuo intervallo, lavora su questa ARRAY e poi copia i dati sull'intervallo i tempi saranno brevissimi pochi secondi contro ... i minuti di prima con un intervallo di "4000" righe e "6" colonne ...

Prova e ...sono QUI

[Anthony47]

Ricky! noi abbiamo impiegato anni prima di usare quella tecnica, vuoi che karug in pochi mesi sia in grado di fare la stessa cosa? (senza nulla togliere al valore dei suoi "Maestri" )

Questa macro usa un algoritmo diverso per identificare i doppioni (la funzione Conta.Se, vs lo scan uno per uno di ogni codice) e soprattutto blocca i ricalcoli, gli eventi e l' aggiornamento dello schermo durante l' esecuzione della macro (riabilitandoli opportunamente a fine macro; vedi le prime 3 e le ultime 3 istruzioni).

Codice: Seleziona tutto

Sub deldup()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
UR = Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Row
For I = UR To 1 Step -1
    If Application.WorksheetFunction.CountIf(Cells(I, 1).Resize(UR - I + 1, 1), Cells(I, 1)) > 1 Then _
        Sheets("Riepilogo").Cells(I, 1).Resize(1, 6).Delete
Next I
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Ciao a tutti

[karug64]

Ricky! noi abbiamo impiegato anni prima di usare quella tecnica, vuoi che karug in pochi mesi sia in grado di fare la stessa cosa? (senza nulla togliere al valore dei suoi "Maestri" )

Premesso che :
- i maestri sono Maestri (con la M maiuscola)
- i Maestri sono sempre disponibili
- i Maestri sono eccezionalmente preparati

ho provato la soluzione di Anthony e sono passato da 3 minuti e 25 sec. a 52 secondi !!!
Mi potrei ritenere assolutamente soddisfatto.

Con un po' di calma ora "cerchero'" di metter su la soluzione di Ricky per vedere "che l'effetto che fa" .....

Grazie a tutti e due.

[Anthony47]

Non mi tornano i tempi: nelle prove fatte, 5000 linee elaborate sistematicamente in 5-7 secondi, cancellandone circa 3000; la macro iniziale (avendo inserito il blocco dei ricalcoli, degli eventi e dell' aggiornamento dello schermo) con gli stessi dati richiede 4m30sec.
Senza duplicati, 2000 righe vengono processate in 0.9 vs 22 secondi
Risultati analoghi su XL2003 e XL2010.

Puoi provare subito dopo il boot del pc, cioe' con un pc non sovraccarico; e (soprattutto) con gli stessi dati di partenza.

Ciao

[ricky53]

Ciao Anthony,
sul mio PC e Office 2003 con 4.000 righe tempi da 4 a 4,2 secondi ottenendo 400 righe dopo aver cancellato 3600 righe duplicate.


Karug64: prima leggi quanto ti ha scritto Anthony e poi ... il tuo tempo è molto alto, strano. Quanta RAM libera hai? Quali applicazioni girano?

[karug64]

Allora. Mia situazione:
Pc core duo a 2Ghz con S.O. linux ubuntu 11.10.
Win Xp su macchina virtuale Virtualbox.

I dati forniti ieri, in effetti, erano errati in quanti comprensivi anche del tempo necessario alla creazione del foglio che poi veniva processato dalla routine.

Oggi la situazione, a macchina appena avviata e senza ulteriori programmi in uso, e' questa:
elaborazione di 3013 righe con risultato finale di 700 righe con cancellazione di 2313 duplicati :

vecchia routine di cancellazione con video abilitato : 2 min. 44 sec.
vecchia routine di cancellazione con video disabilitato : 1 min. 41 sec.
nuova routine di cancellazione con video abilitato : 44 sec.
nuova routine di cancellazione con video disabilitato : 6 sec.

Grazie.

[ricky53]

Ciao,
adesso ci siamo.
La macchia virtuale rallenta un po' ma si passa da 4 a 6 secondi e la differenza non è rilevante.

Buon proseguimento.

[scossa]

Questa macro usa un algoritmo diverso per identificare i doppioni (la funzione Conta.Se, vs lo scan uno per uno di ogni codice) e soprattutto blocca i ricalcoli, gli eventi e l' aggiornamento dello schermo durante l' esecuzione della macro (riabilitandoli opportunamente a fine macro; vedi le prime 3 e le ultime 3 istruzioni).

Ciao Anthony, ciao Ricky ;-)

propongo una soluzione alternativa, non solo perché più veloce ma perché "diversa": utilizza una collection e una variabile range in cui memorizzare le celle da cancellare.

Questi i risultati di prove fatte su 6.211 righe con 17 "codici" diversi, quindi 17 righe restanti, media su 3 risultati, sul mio datato pc AMD Athlon 64 2.41GHz 2GB di RAM:

Codice Anthony: 11,109 secondi
codice scossa: 0,28125 secondi

La differenza è dovuata fondamentalmente al fatto che io cancello ciò che deve essere cancellato tutto insieme con un'unica istruzione, quindi è anche superfluo disabilitare i vari eventi.
Questo i codici utilizzati per il confronto:

Codice: Seleziona tutto

'codice di Anthony47
    Sub deldup()
    Dim nStart As Single
    Dim nStop As Single
    Dim UR As Long
    Dim I As Long
   
    nStart = Timer
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
   
    UR = Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Row
    For I = UR To 1 Step -1
       If Application.WorksheetFunction.CountIf(Cells(I, 1).Resize(UR - I + 1, 1), Cells(I, 1)) > 1 Then _
        Sheets("Riepilogo").Cells(I, 1).Resize(1, 6).Delete
    Next I
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    nStop = Timer
    MsgBox nStop - nStart
    End Sub

Codice: Seleziona tutto

'codice di scossa
    Sub deldup2()
    Dim nStart As Single
    Dim nStop As Single
    Dim UR As Long
    Dim I As Long
    Dim cCod As Collection
    Dim rng As Range
   
    nStart = Timer
   
    Set cCod = New Collection
    UR = Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Cells(UR + 1, 1)
    On Error Resume Next
    For I = UR To 1 Step -1
      cCod.Add Cells(I, 1).Value, CStr(Cells(I, 1))
      If Err.Number <> 0 Then
        Set rng = Union(rng, Cells(I, 1))
        Err.Clear
      End If
    Next I
    Intersect(rng.EntireRow, Columns("A:F")).Delete shift:=xlShiftUp
    nStop = Timer
    MsgBox nStop - nStart
    End Sub

Sarebbe interessante sapere sui vostri pc e coi vostri dati i tempi delle due routine.

[karug64]

Ciao scossa.
Intanto inizio io.
La tua routine ha prodotto il risultato in 1 sec. rispetto ai 6 sec. della routine di Anthony.
Pero' ha un problema, almeno nei mio caso:

se guardi l'allegato

https://rapidshare.com/files/3064725932/Schermata29.png

ti accorgerai che la tua routine cancella anche le righe vuote e quelle di inetstazione tra gli anni, mentre quella di Anthony lascia intatta la struttura del foglio ... Si puo' ovviare ?

Ciao.

[scossa]

Ciao scossa.
Intanto inizio io.
La tua routine ha prodotto il risultato in 1 sec. rispetto ai 6 sec. della routine di Anthony.
Pero' ha un problema, almeno nei mio caso:

ti accorgerai che la tua routine cancella anche le righe vuote e quelle di inetstazione tra gli anni, mentre quella di Anthony lascia intatta la struttura del foglio ... Si puo' ovviare ?

Ciao,

sinceramente non mi pare: cancella le celle della colonna A:F e non di altre colonne, come del resto fa anche quella di Anthony, l'unica "licenza" che mi sono concesso è di cancellare anche le celle A:F della riga successiva all'ultima valorizzata, ma questo non dovrebbe essere un problema.

Per darti una risposta concreta dovrei vedere il tuo file reale per poter verificare, se puoi condividerlo.

[karug64]

Ciao scossa.
Il file che ho postato in effetti lo devi vedere diviso in due. Le colonne da A ad F sono quelle frutto della tua elaborazione, quelle piu' a destra sono quelle frutto dell'eleborazione della routine di anthony. Come vedi i codici estratti sono uguali, ma nell'estrazione di destra continuano ad esserci le righe gialle (intestazioni di anni) che non vengono cancellate, mentre nel risultato della tua elaborazione non ci sono.
Spero di essermi spiegato.
Ciao.

[ricky53]

Ciao Scossa,
bella soluzione hai fatto proprio una cosa diversa e ... anche molto veloce.
Io ho buttato giù del codice che utilizza le array ma non è così veloce a fronte di 0,420 secondi tuoi io ho 0,810 secondi con 4.000 righe e 3.620 cancellazioni, però comunque è dello stesso ordine di grandezza.

Karug64: dovevi dire come erano effettivamente organizzati i tuoi dati. Non avevi detto che tra i dati c'erano le intestazioni che dovevano rimanere !!!
Sarebbe il caso di vedere un tuo file di esempio; ovviamente senza dati riservati.

[Anthony47]

Ciao Scossa, lieto del tuo intervento.
Premetto che non sono in grado di partecipare alla festa dei numeri perche' purtroppo non sono riuscito a misurare l' improvement che tutti avete testimoniato: non so perche', ma a me la macro byScossa non produce effetti significativi, con durata confrontabile con quella della macro originale.
Vi giro il file su cui ho fatto le prove, e su cui sono disponibili una serie di altre macro, e vi prego di ripetere le vostre prove su questo file.
https://rapidshare.com/files/2807139664 ... 0402-1.xls

Il pulsante presente su Riepilogo consente di eseguire le 5 macro in sequenza, ripristinando di volta in volta i dati iniziali, memorizzando i tempi nell' area L1:U2.
Le colonne usate per il test sono A:F piu' la zona L1:U2 usata per il calcolo dei tempi.

Diciamo subito che mi aspettavo un drastico miglioramento, in quanto Scossa ha colto che il tempo maggiore e' speso per il delete dei singoli range, e intelligentemente hai raggruppato queste operazioni in un unico momento; a maggior ragione non capisco il motivo sul mio pc del mancato miglioramento.
Questo mi impedisce infine di valutare l' impatto dell' uso del Dictionary (invece della Collection; macro DELDUP22); mi aspetterei che questa tecnica sia ancora piu' veloce in quanto usa la proprieta' "Exists" invece della condizione di errore per determinare la presenza della voce. Infatti questa macro nei miei test rimane la piu' veloce, ma con tempi di esecuzione MOLTO piu' alti di quanto risulta a voi e decisamente confrontabili con le altre soluzioni testate.
Saro' lieto di leggere i vostri risultati, spero prima o poi di capire il perche' dei miei problemi di misurazione.

Tuttavia (karug mi perdonera', spero, per quello che vado a dire) il mio obiettivo era di offrire un punto di partenza, che l' utente fosse quindi in grado di metabolizzare e adattare alle sue esigenze; da questo aspetto l' uso della WorksheetFunction.CountIf penso sia piu' semplice della New collection e del Dictionary.
A Ricky (forse) anche io avrei proposto una cosa piu' sofisticata ("forse" e' dubitativo della mia capacita' creativa, non della capacita' di Ricky di metabolizzare...)

Grazie ancora per l' intervento.

Ciao a tutti

[scossa]

non so perche', ma a me la macro byScossa non produce effetti significativi, con durata confrontabile con quella della macro originale.

Ciao Anthony, (ricky, karug),

fondamentalmente la differenza nei tempi da te misurati, relativamente alla mia routine, è dovuta al fatto che per il mio test ho usato pochi codici,17, ripetuti per 6000 righe (questa era la situazione che avevo intuito dall'esempio dell'OP), mentre la tua basedati è di 1976 codici ripetuti su 5000 righe.
Questo comporta che, coi miei dati ci sono solo 8 "errori", quindi "set rng" viene eseguito 8 volte (8 areas in rng); mentre coi tuoi dati si hanno 933 errori con altrettante esecuzioni di "set rng".
Visti i risultati postati da karug, direi che l base dati è simie a quella che ho usato io.

Certo che su una base dati come la tua non è la collection (che in inserimento dati è veloce) che porta via tempo ma proprio per l'istruzione "set rng = Union..." che è lenta (se commenti quell'istruzione nel mio codice vedrai che il ciclo della collection è velocissimo).

Interessante discussione, spero di avere tempo per approfondire, sperando anche nel vostro contributo.

[Anthony47]

Ah ah, ho beccato proprio la zona di minore performances della tua macro! (a mia scusante c' e' che avevo sempre fatto le prove in queste condizioni: 5000 linee con circa 2000 valori unici)
Questa e' la curva di performance delle 5 macro presenti sul file:


Uploaded with ImageShack.us
(tasto dx /Visualizza immagine per l' immagine completa)

Le voci elencate sul grafico corrispondono a:
-deldup, la macro originale di Anthony
-deldupAB, la stessa macro rivista usando Set Rng come da macro di Scossa
-deldup22, una macro che usa l' oggetto Dictionary per sondare la presenza di un valore (vedi lising successivo)
-deldup22AB, e' la macro che usa il Dictionary modificata per usare Set Rng
-deldup2, e la macro pubblicata da scossa
-deldup1, una macro ibrida che usa un array per sondare la presenza di un valore

Il cuore della macro che usa il Dictionary piu' la tecnica Set Rng e' questo codice:
'

Codice: Seleziona tutto

Set MyDict = CreateObject("Scripting.Dictionary
'
'
'
Set rng = Cells(UR + 1, 1).Resize(1, 6)
For I = UR To 1 Step -1
        If Not MyDict.exists("" & (Cells(I, 1))) Then
            MyDict.Add ("" & Cells(I, 1)), "1"
        Else
    Set rng = Union(rng, Cells(I, 1).Resize(1, 6))
        End If
Next I
rng.Delete shift:=xlShiftUp


Lo riporto perche' e' l' unica soluzione che compete in termini di prestazioni con la macro "by scossa".
Interessante anche notare come per ogni situazione l' approccio ottiamale varia:
-con tantissime o pochissime cancellazioni la tecnica Set Rng/Union vince alla grande; questo e' dovuto al fatto che le aree da unire sono sempre poche.
-con una situazione tipo 50/50 altri approcci possono essere vantaggiosi

Spero di non avervi confuso oltre le mie intenzioni
Ciao a tutti

[scossa]

......

[scossa]

Questo comporta che, coi miei dati ci sono solo 8 "errori", quindi "set rng" viene eseguito 8 volte (8 areas in rng); mentre coi tuoi dati si hanno 933 errori con altrettante esecuzioni di "set rng".
Visti i risultati postati da karug, direi che l base dati è simie a quella che ho usato io.

Ho risposto in fretta e in modo impreciso.
Ora sono di corsa ma poi preciserò meglio.

@Anthony: idem per la tua risposta.

[scossa]

Questo comporta che, coi miei dati ci sono solo 8 "errori", quindi "set rng" viene eseguito 8 volte (8 areas in rng); mentre coi tuoi dati si hanno 933 errori con altrettante esecuzioni di "set rng".
Visti i risultati postati da karug, direi che l base dati è simie a quella che ho usato io.

Ho risposto in fretta e in modo impreciso.
Ora sono di corsa ma poi preciserò meglio.

Eccomi qua.

Come dicevo avevo risposto in fretta, senza riflettere troppo.

Quello che rende lenta la mia routine con la tua basedati non è il numero di "errori" (4024) ma è il numero di aree discontinue (933) che il metodo .Union() deve elaborare.

Infatti se (con la tua basedati) modifichiamo (ovviamente per solo scopo dimostrativo) la chiamata da:

Codice: Seleziona tutto

Set rng = Union(rng, Cells(I, 1))


a:

Codice: Seleziona tutto

x = x + 1
If x MOD 40 = 0 Then x = x + 10
Set rng = Union(rng, Cells(UR + x, 1))


creando quindi solo 101 aree (sempre con 4024 errori), impiega una frazione di secondo ad eseguire la sub.
Già con MOD 5 che crea 605 aree il tempo si avvicina a quello con Set rng = Union(rng, Cells(I, 1)).

Questo il codice di prova (che NON cancella materialmente le righe ma non serve farlo ai fini del test):

Codice: Seleziona tutto

   
    Sub deldup2()
    Dim nStart As Single
    Dim nStop As Single
    Dim UR As Long
    Dim I As Long
    Dim cCod As Collection
    Dim rng As Range
    Dim x As Long
   
    nStart = Timer
    Set cCod = New Collection
    UR = Sheets("Riepilogo").Range("A" & Rows.Count).End(xlUp).Row
    Set rng = Cells(UR + 1, 1)
    On Error Resume Next
    For I = UR To 1 Step -1
      cCod.Add Cells(I, 1).Value, CStr(Cells(I, 1))
      If Err.Number <> 0 Then
        x = x + 1
        If x Mod 40 = 0 Then x = x + 10
        Set rng = Union(rng, Cells(UR + x, 1))
        'Set rng = Union(rng, Cells(I, 1))
        Err.Clear
      End If
    Next I
    'Intersect(rng.EntireRow, Columns("A:F")).Delete shift:=xlShiftUp
    nStop = Timer
    MsgBox nStop - nStart & vbCrLf & x & " errori" & vbCrLf & _
      rng.Areas.Count & " aree (" & rng.Address & ")"
    Set rng = Nothing
   
    End Sub


Questo dimostra chiaramente che il problema è proprio legato al metodo .Union()

Soluzioni alternative?
Ho provato a memorizzare in una stringa gli indirizzi delle varie celle:

Codice: Seleziona tutto

If Err.Number <> 0 Then
  sInd = Cells(I, 1).Address


per assegnare, a ciclo concluso, a rng:

Codice: Seleziona tutto

set rng = range(sInd)

ma funziona solo per stringe (sInd) molto corte, nel nostro caso si avrebbe un errore run-time di assegnazione a rng.
Quindi non è percorribile.

Altre idee?