Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Sub cancella righe con verifica condizione ... uso degli array

423 views
Skip to first unread message

Final Job

unread,
Jul 4, 2019, 7:35:09 AM7/4/19
to

Buongiorno;

utilizzo questa macro per cancellare le righe di un foglio che
presentino una certa condizione (in questo caso una smarcatura in una
delle due celle citate in "If").

Domanderei, per velocizzarne l'esecuzione, come si potrebbe sviluppare
un codice sostitutivo che effettui il lavoro in memoria.

La procedura che riporto esegue nel foglio1 sia la verifica che
l'eventuale eliminazione delle righe. Capita anche di effettuare la
verifica in un foglio differente da quello in cui si opera (esempio il
Foglio2).


Sub CancellaRighe ()
Dim n As Long
Dim UltimaRiga As Long

With Sheets("Foglio1")
UltimaRiga = .cells(Rows.Count, 24).End(xlUp).Row

For n = UltimaRiga To 6 Step -1

If .cells(n, 25).Value = "X" Or .cells(n, 50).Value = "X" Then
.cells(n, 50).EntireRow.Delete
End If

Next n

End With

End Sub

Buona giornata e grazie per l'attenzione.
Ale

casanmaner

unread,
Jul 4, 2019, 10:06:06 AM7/4/19
to
In caso di utilizzo "Stand Alone" probabilmente l'uso di array in memoria per l'eliminazione di righe non porterebbe a notevoli vantaggi in tempi di tempi.
Ma appena ho un momento provo a fare una verifica.

Final Job

unread,
Jul 4, 2019, 10:39:23 AM7/4/19
to
non è lentissima e la modifico all'occorrenza anche per altre cose;
quando la costringo ad elaborare di più, i tempi si modificano
evidentemente. Non rappresenta un grosso problema a livello pratico però
sono rimasto impressionato dalla differenza di esecuzione dei codici
postati da te. La curiosità è naturale.

Ciao
Ale


Il 04/07/2019 16:06, casanmaner ha scritto:
> In caso di utilizzo "Stand Alone" probabilmente l'uso di array in memoria per l'eliminazione di righe non porterebbe a notevoli vantaggi in tempi di tempi.
> Ma appena ho un momento provo a fare una verifica.
>
> ---
> Questa email è stata esaminata alla ricerca di virus da AVG.
> http://www.avg.com
>


casanmaner

unread,
Jul 4, 2019, 10:51:30 AM7/4/19
to
Il giorno giovedì 4 luglio 2019 16:39:23 UTC+2, Final Job ha scritto:
> non è lentissima e la modifico all'occorrenza anche per altre cose;
> quando la costringo ad elaborare di più, i tempi si modificano
> evidentemente. Non rappresenta un grosso problema a livello pratico però
> sono rimasto impressionato dalla differenza di esecuzione dei codici
> postati da te. La curiosità è naturale.
>

In questo caso il problema è che non si può "eliminare" una riga da una matrice ma occorre creare una nuova matrice solo con gli elementi che non si vogliono eliminare.
Quindi il vantaggio nell'effettuare cicli in memoria viene perso perché occorre usare un ciclo per popolare la matrice con i soli dati di interesse.
Quindi si fa prima a fare il ciclo nel foglio ed eliminare le righe che non interessano.

Discorso differente era nell'altro caso se tale operazione fosse stata da fare immediatamente dopo perché invece di eseguire un nuovo ciclo dell'intero intervallo, sfruttando il medesimo ciclo si possono memorizzare le righe da eliminare e poi eseguire un ciclo limitato alle sole righe da eliminare.

Vedi questo esempio dove simulo una situazione di eliminazione dei dati dalla matrice:
https://www.dropbox.com/s/0gt3940iso4ylqr/Sub%20cancella%20righe%20con%20verifica%20condizione%20...%20uso%20degli%20array.xlsm?dl=0

Final Job

unread,
Jul 4, 2019, 10:59:33 AM7/4/19
to
Tutto Chiaro
Grazie
Ale

buonoc...@gmail.com

unread,
Jul 4, 2019, 1:26:12 PM7/4/19
to
Io sfrutto il metodo elimina duplicati dell'oggetto range. Creo una colonna calcolata (ultima colonna a sinistra del range di dati) ch etesta se le condizioni di eliminazione sono soddisfatte; in tal caso la formula restituisce zero altrimenti restituisce il riferimento di riga.
Nel caso di esempio di Ale la formula può essere:
=SE(E(Foglio1!$Y2="X";Foglio1!$AX2="X");0;RIF.RIGA(Foglio1!$A2))

La macro che segue elimina i duplicati sulla colonna calcolata che non possono avere che valore zero. L'unico che resta viene individuato ( per es co metodo find e poi eliminato.
Nalla macro il range di dati è denominato 'Dati'

Option Explicit

Sub EliminaRigheMarcateRange()
Dim rngDati As Range
Dim rngSearch0 As Range
Dim rngCalcColumn As Range
Dim lngCols As Long
On Error GoTo ErrHandler

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set rngDati = Range("Dati")
lngCols = rngDati.Columns.Count
rngDati.RemoveDuplicates Columns:=lngCols, Header:= _
xlYes
Set rngCalcColumn = rngDati.Columns(lngCols)

Set rngSearch0 = rngCalcColumn.Find(0, rngCalcColumn.Cells(1, 1), xlValues, xlWhole, xlByRows, xlNext)

If Not rngSearch0 Is Nothing Then
rngSearch0.EntireRow.Delete
End If
ExitProc:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
ErrHandler:
MsgBox Err.Description
Resume ExitProc
End Sub

Final Job

unread,
Jul 4, 2019, 5:46:45 PM7/4/19
to
Il 04/07/2019 19:26, buonoc...@gmail.com ha scritto:

Buonasera Elio, interessante.
La colonna di appoggio deve essere la prima a sinistra della tabella dei
dati? Ho capito bene?
ciao e grazie
Ale

> Io sfrutto il metodo elimina duplicati dell'oggetto range. Creo una colonna calcolata (ultima colonna a sinistra del range di dati) che testa se le condizioni di eliminazione sono soddisfatte; in tal caso la formula restituisce zero altrimenti restituisce il riferimento di riga.

Final Job

unread,
Jul 4, 2019, 6:00:38 PM7/4/19
to
Il 04/07/2019 16:51, casanmaner ha scritto:

Infatti ... la soluzione con l'uso della matrice è più lenta

> .............. Quindi il vantaggio nell'effettuare cicli in memoria viene perso perché occorre usare un ciclo per popolare la matrice con i soli dati di interesse.

casanmaner

unread,
Jul 4, 2019, 6:33:29 PM7/4/19
to
Per curiosità ho voluto provare a "simulare" con solo VBA la soluzione di Elio inserendo una colonna d'appoggio ed eliminando le righe con i duplicati (che assumono il valore 0) e poi eliminare la colonna d'appoggio.
Però i temi di esecuzione sono a vantaggio di tale soluzione, rispetto a quella di passare le righe ed eliminarle in maniera classica, solo se vi sono molte righe da eliminare.
Ad es. con il mio PC su 50.000 righe dati e 50 righe da eliminare i tempi risultano questi:
CancellaRighe: 1,12793
CancellaRigheConEliminaDuplicati: 1,639038
con un leggero vantaggio per la procedura classica

con 100 righe da eliminare:
CancellaRighe: 1,351929
CancellaRigheConEliminaDuplicati: 1,654053

con 200 righe da eliminare:
CancellaRighe: 1,924072
CancellaRigheConEliminaDuplicati: 1,674927

se con lo stesso numero di righe dati ci sono 1.000 righe da eliminare i tempi diventano questi:
CancellaRighe: 5,576904
CancellaRigheConEliminaDuplicati: 1,638916

con 2.000 righe da eliminare:
CancellaRighe: 10,29492
CancellaRigheConEliminaDuplicati: 1,677979

diciamo che da un certo punto in poi mentre la procedura "classica" incrementa i tempi di lavorazione quella che sfrutta la funzione di eliminazione dei duplicati rimane costante.

Questa la routine se volete fare delle prove:

Sub CancellaRigheConEliminaDuplicati()
Dim iTimer: iTimer = Timer

Const sPrimaColonnaDati As String = "A"
Const sUltimaColonnaDati As String = "AX"
Const sPrimaRigaDati As Long = 6

Dim n As Long, i As Long, cont As Long
Dim UltimaRiga As Long
Dim iColumnsCount As Long
Dim IntDati As Range
Dim arrDati As Variant

Dim arrDuplicati() As Variant 'seconda matrice da popolare con i dati che non sono da eliminare
Dim iUltimoDuplicato As Variant

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

With Sheets("Foglio1")
UltimaRiga = .Cells(Rows.Count, 24).End(xlUp).Row
Set IntDati = .Range(sPrimaColonnaDati & sPrimaRigaDati & ":" & _
sUltimaColonnaDati & UltimaRiga)
arrDati = IntDati.Value
ReDim arrDuplicati(1 To UltimaRiga - sPrimaRigaDati + 1, 1 To 1)
For n = LBound(arrDati, 1) To UBound(arrDati, 1)
cont = cont + 1
If UCase(arrDati(n, 25)) <> "X" And UCase(arrDati(n, 50)) <> "X" Then
arrDuplicati(cont, 1) = cont
Else
arrDuplicati(cont, 1) = 0
End If
Next n
With IntDati
iColumnsCount = .Columns.Count
With .Offset(-1, iColumnsCount).Resize(1, 1)
.Value = "Campo Temp"
.Offset(1).Resize(UltimaRiga - sPrimaRigaDati + 1).Value = arrDuplicati
End With
.Resize(, iColumnsCount + 1).RemoveDuplicates Columns:=iColumnsCount + 1, Header:=xlNo
iUltimoDuplicato = Application.Match(0, .Columns(iColumnsCount + 1), 0)
End With
If Not IsError(iUltimoDuplicato) Then
.Rows(iUltimoDuplicato + sPrimaRigaDati - 1).Delete
End If
IntDati.Columns(iColumnsCount + 1).EntireColumn.Delete
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Debug.Print "CancellaRigheConEliminaDuplicati: " & (Timer - iTimer)

End Sub

buonoc...@gmail.com

unread,
Jul 5, 2019, 4:46:12 PM7/5/19
to
x Ale
Scusa il refuso ma intendevo l'ultima colonna sulla destra (il codice vba proposto punta a quella). Non che sia obbligatorio ma così è più facile reperire il riferimento alla colonna calcolata nel codice.

x Ermanno
Secondo me non è solo un problema di tempi di esecuzione ma anche di flessibilità e facilità di manutenzione del codice. Se cambiano i criteri anche complessi per definire un record eliminabile è più facile modificare una formula su foglio di lavoro che l'algoritmo di un codice vba. Il mio codice vba è invariante rispetto ai criteri di selezione dei record da eliminare.
Intanto ho pensato che in realtà modificando l'intestazione di colonna calcolata ponendola come valore uguale a quello restituito dalla formula (nel nostro caso uno zero statico) non è necessario trovare l'ultimo record con il metodo find. Infatti se al metodo RemoveDuplicates viene passato il parametro Header:=xlNo tutte le righe sottostanti la riga di intestazione con zero in colonna calcolata saranno eliminate, in quanto la prima occorrenza di zero, risparmiata dal metodo, sarà proprio della riga di intestazione.
Altro possibile vantaggio:
Le celle rimosse sono solo quelle inizialmente all'interno del range di dati; in sostanza non vi è nessuna rimozione di intera riga del foglio di lavoro. In questo RemoveDuplicates su elenco normale agisce come se questo fosse un ogegtto tabella.

Elio

Final Job

unread,
Jul 6, 2019, 8:12:05 AM7/6/19
to
Il 05/07/2019 22:46, buonoc...@gmail.com ha scritto:
Grazie Elio, Molto interessante.
Ale

Final Job

unread,
Jul 6, 2019, 8:14:11 AM7/6/19
to
Grazie Ermanno
Ale

casanmaner

unread,
Jul 6, 2019, 8:24:31 AM7/6/19
to
Ciao Elio,
personalmente non amo le "colonne d'appoggio" ma si stratta di una preferenza personale.
E visto che comunque si usa il vba se posso cerco di non usarle.
Vero che così non si deve toccare il codice vba ma "solo" le formule nelle celle ma anche lì dipende. Personalmente riesco più facilmente a "leggere" (ed eventualmente modificare) differenti condizioni scrivendole in vba che con differenti condizioni con le "formule piatte" in una cella.

Non è una formula a cui è legata qualche condizioni ma ad un risultato da restituire in base ad una data percentuale ma ad es. questa FDU scritta in VBA personalmente riesco a gestirla molto più semplicemente con VBA che se dovessi scriverla in una cella :)

Function SettoreIndustriaGiudizioG(v As Variant) As String
Dim r As String
If v = "" Then Exit Function
If v >= -0.3 And v < -0.14 Then
r = "MB"
ElseIf v >= -0.14 And v < -0.04 Then
r = "M"
ElseIf v >= -0.04 And v < 0.032 Then
r = "MA"
ElseIf v >= 0.032 And v < 0.135 Then
r = "A"
ElseIf v >= 0.135 And v < 0.171 Then
r = "MA"
ElseIf v >= 0.171 And v < 0.222 Then
r = "M"
ElseIf v >= 0.222 And v < 0.303 Then
r = "MB"
ElseIf v >= 0.303 Then
r = "B"
End If
SettoreIndustriaGiudizioG = r
End Function


Non ha nulla ha che fare con questa problematica ma solo per dire che personalmente mi è più facile scrivere questo codice che pensare di riportare in una formula nella cella le varie condizioni :)

buonoc...@gmail.com

unread,
Jul 6, 2019, 9:00:07 PM7/6/19
to
Intanto la scelta di una colonna calcolata per il problema di Ale era funzionale allo sfruttamento 'non ortodosso' di RemoveDuplicates che trovo essere un metodo molto potente e pertanto non ne faccio un tabù che la soluzione possa essere mista (formula + VBA). Il suggerimento può essere anche utilizzato al volo solo con formule e interfaccia utente con il mio ultimo suggerimento (colonna intestata con zero).
Per il tuo ultimo esempio mi permetto di obiettare che non vedo necessità di utilizzare codice se la soluzione è diretta all'interfaccia utente, per esempio con uso con ricerca binaria di CERCA.VERT:

TabellaRicerca (intervallo denominato su foglio di lavoro o matrice di costanti denominata)
-0,3 MB
-0,14 M
-0,04 MA
0,032 A
0,135 MA
0,171 M
0,222 MB
0,303 B

in A1 valore di input

Dove si vuole:

=CERCA.VERT(A1;TabellaRicerca;2;VERO)

Intendiamoci. Non ho nulla contro il VBA, gli array e le UDF. Vi ricorro quando costituiscono, nel contesto di utilizzo, alternativa superiore per performance, flessibilità e manutenzione a ciò che si può fare all'interfaccia utente. A titolo esemplificativo e non esaustivo si pensi alla miriade di situazioni di necessità di 'clean-up' dei dati oggi possibile con power query e prima possibile solo con uso intensivo di array con vba. Le soluzioni migliori in Excel 2003 spesso non sono più tali in Excel 2016 / 2019.
Non ho nessun spirito di polemica anzi ti confermo il grande interesse che ho nel leggere il tuo codice dal quale ho tanto appresso.

Ciao
Elio

casanmaner

unread,
Jul 7, 2019, 1:32:30 AM7/7/19
to
Il giorno domenica 7 luglio 2019 03:00:07 UTC+2, buonoc...@gmail.com ha scritto:

>
> non ne faccio un tabù c
Nessun tabù ma come ho detto personalmente se posso avere meno "colonne" o "zone" di appoggio lo preferisco per una questione di mio "ordine mentale" :=


> Per il tuo ultimo esempio mi permetto di obiettare che non vedo necessità di utilizzare codice se la soluzione è diretta all'interfaccia utente, per esempio con uso con ricerca binaria di CERCA.VERT:
>
> TabellaRicerca (intervallo denominato su foglio di lavoro o matrice di costanti denominata)
> -0,3 MB
> -0,14 M
> -0,04 MA
> 0,032 A
> 0,135 MA
> 0,171 M
> 0,222 MB
> 0,303 B
>
> in A1 valore di input
>
> Dove si vuole:
>
> =CERCA.VERT(A1;TabellaRicerca;2;VERO)
>
Fosse stata anche solo una avrei anche io utilizzato un cerca.vert molto probabilmente.
Ma per quasi una quarantina tutte differenti ho fatto prima a creami delle UDF che per come sono state nominate e per il fatto di dover far riferimento solo alla cella con il valore da confrontare mi consentono di verificare molto più semplicemente di aver inserito la formula giusta nel punto giusto.
Qui un esempio di una parte composta da 5 settore con un numero differente di fattori di giudizio con differenti valori e scaglioni:
https://www.dropbox.com/s/le0avxrgeq1n93b/Screenshot%202019-07-07%2007.22.38.png?dl=0

0 new messages