Elimina coppie

[domenicoPartecipante domenico]

Buonasera,

potreste gentilmente aiutarmi a creare una macro che elimina i dati doppi, sia la copia che l'originale.

Mi piacerebbe che potesse essere eseguita su tutti i fogli, senza il vincolo di esecuzione in un foglio con un nome specifico e che la macro elimini i doppi nella colonna selezionata.

Vi ringrazio anticipatamente per il tempo che vorrete dedicarmi.

Saluti

[domenicoPartecipante domenico]

Facendo una ricerca nel forum ho trovato questo codice che fa quello che mi serve.... però non so come renderla più flessibile.... mi piacerebbe poterla eseguire su tutti i fogli, senza la limitazione del nome del foglio, e che la macro cancelli i doppi nella colonna selezionata in quel momento. 

Qui di seguito la macro che ho trovato.

'Questa routine elimina tutte e due le righe doppie
 

 Sub Elina_Tutti_I_Doppioni()
 Dim LastRow As Long, K As Long, MemoCanc As Boolean
 'Questo codice ordina i dati rispetto alla
 'colonna B del Foglio1 ed elimina sia
 'le dupliche che l'origine.
 On Error GoTo 50
 With Worksheets("Foglio1")
Application.ScreenUpdating = False
 .UsedRange.Sort .Range("B2"), Header:=xlGuess
 LastRow = WorksheetFunction.CountIf(.Range("B2:B10000"), "<>")
 If LastRow > 1 Then LastRow = LastRow + 3 Else Exit Sub
 For K = LastRow To 4 Step -1
 If .Cells(K, 2) = .Cells(K - 1, 2) Then 'Finchè le trova uguali ..
 .Cells(K, 2).EntireRow.Delete '.. elimina la duplica ..
 MemoCanc = True '.. e si memorizza un flag per l'origine.
 Else 'Quando non le trova uguali ..
 If MemoCanc Then '.. entra solo se ha in memoria ..
 .Cells(K, 2).EntireRow.Delete '.. qualcosa da eliminare ..
 MemoCanc = False '.. quindi resetta.
 End If
 End If
 Next K
Application.ScreenUpdating = True
 .Range("B4").Select
 End With
 Exit Sub
50:  Application.ScreenUpdating = True: MsgBox Err.Description
 End Sub

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

1°) E' sempre meglio inserire il proprio file (senza dati sensibili) per capirne la struttura.

2°) La macro indicata esegue un controllo tra "un dato di una riga e quello nella riga precedente". Ovvio che se due dati in colonna sono uguali ma a distanza maggiore di 1 il duplicato non verrebbe evidenziato.

3°) Per eliminare i doppioni in ogni foglio devi impostare un ciclo per tutti i fogli ma la colonna la devi indicare, non basta "la colonna selezionata" altrimenti, prima di lanciare la macro, dovresti passarti tutti i fogli e selezionare la colonna che ti interessa.

Come puoi ben capire è un po' più complicato di come la poni tu. Ragionaci sopra e sottoponi una tua macro che rispecchi quanto detto sopra, e vi può vedere di correggerla.

 

Ciao,

Mario

[simonello1981Partecipante simonello1981]

Salve, io stamani mi son cimentato un po' sulla questione ed ho provato a scrivere un codice che, indica tutte le celle uguali in una data colonna (che deve essere definita, eventualmente mediante altro pezzo di codice) in un dato foglio (si può poi decidere se eliminarle o meno).

Per testare se funziona ho creato un file con un foglio chiamato "foglio1" e sulla colonna B (in 1 ho messo l'intestazione e dalla 2 in poi ho generato una serie casuale di numeri compresi tra 1 e 1000). 

questo è il codice che ho scritto...non siate offensivi nei commenti, ma costruttivi nelle critiche.

Option Explicit
Const Fl = "foglio1"
Dim lun As Long
Dim mat_i()
Dim mat_ii()
Dim mat_f()
Dim mat_e()
Dim vettore As Range
Dim vettore2 As Range
Dim vettore3 As Range

Dim i As Long
Dim ii As Long
Dim K As Long
Dim kk As Long

Sub indica_doppioni()

'determino quante righe non vuote sono presenti nel
'range di interesse - in questo caso la colonna B

lun = Range(Sheets(Fl).Range("b1"), Sheets(Fl).Range("b1").End(xlDown)).Count

'per accelerare il processo, utile per numerosi record
'trasferisco il range in un vettore [mat_i]

Set vettore = Sheets(Fl).Range("b2:b" & lun)
ReDim Preserve mat_i(1 To lun - 1)

mat_i = Application.Transpose(vettore)

'creo un vettore copia, ma sicuramente si potrebbe evitare

ReDim Preserve mat_ii(1 To lun - 1)

mat_ii = Application.Transpose(vettore)

'creo un vettore [mat_f] che contiene al suo interno solo i
'record del primo vettore che sono ripetuti almeno una volta. di fatto confronto ogni record di mat_i con tutti quelli di mat_ii
K = 0
For i = 1 To (lun - 2)
    kk = 0
    For ii = (i + 1) To (lun - 1)
        
        If mat_i(i) = mat_ii(ii) Then
            
            kk = kk + 1
            
                If kk > 1 Then
                    GoTo avanti
                End If
                
            K = K + 1
            ReDim Preserve mat_f(1 To K)
            mat_f(K) = mat_i(i)
        End If
    Next ii
avanti:
Next i


'creo un nuovo vettore [mat_e] nel quale sono riportate nelle
'posizioni corrette tutti i numeri replicati almeno una volta

ReDim Preserve mat_e(1 To lun - 1)

For i = 1 To lun - 1
    For ii = 1 To K
        If mat_i(i) = mat_f(ii) Then
            mat_e(i) = "x"
        End If
    Next ii
Next i

'riporto sul foglio nella colonna C con una "x" le celle replicate
'che potranno essere rimosse attraverso un cancella righe

Set vettore3 = Sheets(Fl).Range("c2:c" & lun)
vettore3 = Application.Transpose(mat_e)


Erase mat_i
Erase mat_ii
Erase mat_f
Erase mat_e

End Sub

[Marius44Moderatore Marius44 Karma: 58 pts]

Ciao

@domenico

Bravo  .Ho guardato meglio la tua macro e, in effetti, cancella tutti i doppioni (sol perchè PRIMA hai messo in ordine i numeri della colonna B - ma se ti servissero nell'ordine iniziale?)

 

@simonello1981

Complimenti . Veramente un ottimo lavoro. Potresti implementarlo col codice relativo alla cancellazione delle righe doppie.

@per tutti e due (suggerimento)

Completate il lavoro con il ciclo su tutti i fogli   

Buon weekend a tutti,

Mario

[domenicoPartecipante domenico]

Ciao,

rimane comunque il problema di doverla eseguire solo sul foglio DATI e nella colonna B,  ed io non ho la più vaga idea di come fare.

La modifica che mi piacerebbe implementare renderebbe qualunque macro estremamente flessibile.

Grazie

 

[OscarPartecipante Oscar Karma: 45 pts]

Prova anche questa  (imposta la colonna che devi eliminare tutti i valori  doppi 

Questa elimina nella colonna (A) la devi modificare in base alle tue esigenze

 

 

Private Sub CommandButton1_Click()
Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A1:A" & LR).RemoveDuplicates Columns:=1.2
End Sub

[simonello1981Partecipante simonello1981]

Ciao Oscar, con tre passaggi hai fatto quel che io avrei fatto con mille mila righe di codice... tutto grazie ad un Removeduplicates... il potere della conoscenza 😉

Bisogna che inizi a studiare più approfonditamente queste funzioni o metodi o come si chiamano 

[Marius44Moderatore Marius44 Karma: 58 pts]

Salve a tutti

@oscar

Sì, ci avevo pensato anch'io ma  ....  l'Utente ha chiesto

che elimina i dati doppi, sia la copia che l'originale

e così facendo l'originale rimane (o sbaglio?)

 

Ciao,

Mario

[domenicoPartecipante domenico]

Esatto,

mi piacerebbe poter eliminare sia la copia che l'originale, senza vincoli di nome foglio che di colonna.

saluti

[GiuseppeMNPartecipante GiuseppeMN Karma: 19 pts]

Salve @domenico;
leggo solo ora.

A proposito di:

... mi piacerebbe poter eliminare sia la copia che l'originale, senza vincoli di nome foglio che di colonna.

Allega un File senza Dati sensibili con alcuni Record significativi già inseriti; questo eviterebbe a chi desidera aiutarti dover ricostruire una probabile struttura con il rischio di non centrare l'obiettivo.

 

Giuseppe

 

[GiuseppeMNPartecipante GiuseppeMN Karma: 19 pts]

Buon pomeriggio a Tutti.

... Allega un File senza Dati sensibili con alcuni Record significativi già inseriti ...

@domenico;
sono consapevole che la mia richiesta può sembrare inopportuna e probabilmente inadeguata ma, proprio oggi, ho maldestramente rotto la mia "sfera di cristallo" grazie alla quale riuscivo a "percepire" le reali intenzioni degli Utenti che chiedono conforto in questo Forum.

Per fortuna, poco prima del tragico evento il mio "Spirito guida" mi ha suggerito di:
- Eseguire il conteggio delle ricorrenze di ogni Record presente nella Colonna selezionata
- Conseguentemente eseguire la "decimazione" di tutte le ricorrenze
- Inserire l'eventuale operazione di riordino dei Record ancora presenti nella Colonna selezionata

Sembra funzionare!

Considerando lo scarso interesse per la soluzione della richiesta, non mi resta che augurare buon proseguimento.

 

Giuseppe

[domenicoPartecipante domenico]

Buonasera,

come giustamente chiedeva Giuseppe, allego un file excel con un'esempio dei dati di origine e del risultato che vorrei ottenere.

Saluti

 

Allegati:

You must be logged in to view attached files.

[GiuseppeMNPartecipante GiuseppeMN Karma: 19 pts]

A beneficio degli Utenti interessati a questa discussione allego il File .xlsm

A margine di quanto sopra vorrei ricordare che allegare un File senza Dati sensibili con alcuni Record significativi già inseriti chiarendo ciò che si desidera ottenere dovrebbe essere la regola.

 

Giuseppe

Allegati:

You must be logged in to view attached files.

[tanimonPartecipante tanimon Karma: 16 pts]

ciao a tutti,

innanzi tutto, un rammarico per la "sfera di cristallo" di Giuseppe, mi spiace veramente.

secondariamente

domenico ha scritto:

Esatto,

mi piacerebbe poter eliminare sia la copia che l'originale, senza vincoli di nome foglio che di colonna.

saluti

poi finalmente su richiesta di Giuseppe, L'op allega un file

 

dal quale la richiesta quotata poco sopra, è nettamente smentita:

MARCO, LUIGI, LUCA, ANDREA, LAURA, SARA (per come li ho intesi, ORIGINALI),

devono restare nel risultato atteso, (quindi non si cancellano gli originali,

anzi nell'esempio viene "eliminato solo "NICO" e quindi è veramente un semplice "rimuovi duplicati")

 

tant'è che Mario scrive:

Marius44 ha scritto:

Sì, ci avevo pensato anch'io ma  ....  l'Utente ha chiesto

che elimina i dati doppi, sia la copia che l'originale

e così facendo l'originale rimane (o sbaglio?)

ma non solo,

avevo inteso che il risultato avrebbe dovuto essere raggiunto su tutti fogli e per ogni colonna.

 

 
 

invece dal file finalmente allegato, il risultato atteso è solo per la colonna "F" del foglio attivo.

 

quindi:

GiuseppeMN ha scritto:

vorrei ricordare che allegare un File senza Dati sensibili con alcuni Record significativi già inseriti chiarendo ciò che si desidera ottenere dovrebbe essere la regola.

 

Giuseppe

risulta determinate ed indispensabile per ogni supporto si voglia fornire.

 

Ai lettori ed agli interessati le valutazioni del caso.

 

ciao

Frank

[domenicoPartecipante domenico]

Sinceramente non capisco la polemica.

Che io sappia tutti i fogli di excel devono obbligatoriamente avere un nome..... ed era per questo che non volevo inviare un file, perchè ero sicuro che qualcuno mi avrebbe detto esattamente le stesse cose, cioè che nel file inviato il foglio aveva un nome e che i dati erano in una colonna specifica.

La mia domanda, come ho scritto nei post precedenti,  è di poter eseguire la macro senza vincoli di nome foglio, inoltre quando dico che la macro dovrebbe lavorare nella colonna selezionata, vuol dire che oggi la colonna selezionata è la B, ma domani potrebbe essere la Z.

Quindi.... oggi potrei avere la necessità di eseguire la macro  sul Foglio1 nella Colonna B, mentre domani potrei avere la necessità di eseguire la macro sul foglio5 nella colonna C.

Era questo il senso della mia domanda.

Il massimo della flessibilità, senza dover ogni volta,  andare nel codice a modificare il nome del foglio e la colonna.

La macro dovrà lavorare nel foglio attivo e nella colonna selezionata nel momento dell'esecuzione della macro.

Nel file di esempio, nella colonna RISULTATO DA OTTENERE, non ci sono i dati doppi e gli originali....

NICO è presente 3 volte nella colonna ORIGINE..... quindi un originale e due copie di NICO, in questo caso tutti e tre i NICO dovrebbero essere cancellati, come si vede nella colonna RISULTATO DA OTTENERE.

Grazie a tutti

 

 

[GiuseppeMNPartecipante GiuseppeMN Karma: 19 pts]

Buona giornata a tutti.

@domenico, scrive:
... NICO è presente 3 volte nella colonna ORIGINE..... quindi un originale e due copie di NICO, in questo caso tutti e tre i NICO dovrebbero essere cancellati, come si vede nella colonna RISULTATO DA OTTENERE.

Direi che è esattamente quello che accade nel File che ho allegato in precedenza, o mi sbaglio?; inoltre vorrei precisare che:
- Il Codice VBA funziona su tutti i Fogli di lavoro
- La scelta della Colonna da analizzare non è un problema
- Basta posizionare il cursore su una Cella della Colonna da analizzare
- Eseguire, con un po di fantasia, una piccola modifica al Codice VBA

Nei miei Test avevo considerato 5 Colonne potendo decidere quale Colonna valutare.
Per fare ciò avevo:
- Dichiarato le due Costanti come Variabili, Clm as Byte e Clx as String
- Aggiunto un'istruzione per determinare in Clm la Colonna da valutare
- Utilizzato Select Case Clm per determinare in CLx la Colonna da Valutare
- Per concludere, avevo evitato di "eliminare bovinamente" le Celle vuote utilizzando l'Ordinamento della Colonna

Ma ho preferito utilizare le informazioni presenti sul File che l'Utente aveva allegato e considerando che "il Cliente ha sempre ragione", ho pensato bene di utilizzare:
- Un solo Foglio di lavoro
- Una sola Colonna da valutare

In realtà nel File era presente anche la Colonna "RISULTATO DA OTTENERE" ma l'ho considerata come una indicazione.

Tanto è dovuto.

Giuseppe

[Autore]

Articoli