Condividi:        

macro per copiare un elenco senza doppioni

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

macro per copiare un elenco senza doppioni

Postdi Ale75 » 27/07/22 14:56

Salve,

ho realizzato una macro con l'idea di scorrere un elenco (ad esempio nella colonna A del primo Foglio) e copiare lo stesso elenco nella seconda pagina ma senza doppioni. inoltre vorrei copiare anche i doppioni indicando il rigo (del primo foglio) dove sono stati trovati

Codice: Seleziona tutto
Sub trovadoppioni()

Dim Cella As Range
Dim Intervallo, Origine, Desinazione As Range

Set Origine = Sheets("Sheet1")
Set Destinazione = Sheets("TagList")
Set Intervallo = Origine.Range("A3:A20")  '-- qui la sorgente di dati

Y = 3
X = 3

For Each Cella In Intervallo

 If WorksheetFunction.CountIf(Range("A3:A" & Cella.Row), Cella) = 1 Then
        Origine.Cells(Cella.Row, 1).Copy   
        Destinazione.Cells(Y, 3).PasteSpecial
        Y = Y + 1
       
    ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then
                Origine.Cells(Cella.Row, 1).Copy
                Destinazione.Cells(X, 5).PasteSpecial
                Destinazione.Cells(X, 6) = Cella.Row
                X = X + 1
    End If
Next Cella
End Sub


formalmente mi sembra corretta, però non va.
il probrelma sembra essere qui
Codice: Seleziona tutto
        Origine.Cells(Cella.Row, 1).Copy
, nel senso che sembra che non copia il valore della cella
sapete dirmi dove sbaglio?

grazie,
Ale
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Sponsor
 

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 27/07/22 22:44

Prova con questa variante:
Codice: Seleziona tutto
For Each Cella In Intervallo
    If WorksheetFunction.CountIf(Origine.Range("A3:A" & Cella.Row), Cella) = 1 Then
        Cella.Copy
        Destinazione.Cells(Y, 3).PasteSpecial
        Y = Y + 1
       
    ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then
        Cella.Copy
        Destinazione.Cells(X, 5).PasteSpecial
        myMatch = Application.Match(Cella.Value, Intervallo, False)
        Destinazione.Cells(X, 6) = myMatch
        X = X + 1
    End If
Next Cella

Se funziona guarda le differenze, credo che il significato sia intuitivo (comunque siamo qui)
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 28/07/22 07:23

perfetto !

cosi funziona, ma la parte del match mi sono accorto di aver fatto un errore "concettuale".
cioe se un campo è ripetuto 3 volte il match riscrive il tag duplicato 2 volte ma come riferimento della linea da sempre il rigo corrispondente al primo campo dove ha trovato il valore (diciamo l'originale)

come posso fare per far evidenziare tutte le righe duplicate? cioè avere nella lista dei tag duplicati tutti e tre i valori con le rispettive righe, in modo che poi l'operatore vada a vedere le anomalie

grazie ancora,
Ale
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 28/07/22 08:55

Ma allora usa la colonna 6 di Destinazione per scriverci le righe dove compaiono quei valori:
Codice: Seleziona tutto
    For Each Cella In Intervallo
        If WorksheetFunction.CountIf(Origine.Range("A3:A" & Cella.Row), Cella) = 1 Then
            Cella.Copy
            Destinazione.Cells(Y, 3).PasteSpecial
            Destinazione.Cells(Y, 6).Value = Cella.Row            ‘<<< VEDI NOTA
            Y = Y + 1
           
        ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then
            myMatch = Application.Match(Cella.Value, Destinazione.Ramge("C3:C" & Y), False)
            Destinazione.Cells(myMatch, 6).Value = Destinazione.Cells(myMatch, 6) & " > " & Cella.Row
        End If
    Next Cella

Questa crea l’elenco in colonna 3 come prima ma mette in colonna 6 il numero di riga su cui quel valore compare; dove ci sono piu’ occorrenze in colonna 6 ci saranno piu’ numeri di riga, tipo 28 > 55 > 99

Se in colonna 6 non vuoi scrivere la prima occorrenza (che a me sembra invece utile in fase di debug) allora elimina l’istruzione marcata <<<
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 28/07/22 12:27

grazie,

ho fatto due sole modifiche
la prima grafica perche c'era un raMge (con la M), la seconda ho aggiuno un "+2" al
Codice: Seleziona tutto
Destinazione.Cells(myMatch + 2, 6).Value = Destinazione.Cells(myMatch + 2, 6) ...

perche inizio a scivere al rigo 2 sul file di destinazione

il codice è questo, funziona ma da errore in fondo

cioè scorre la lista, scrive le righe pero poi da Runtime-error 13, come se all'ultimo ciclo mancasse qualcosa (però la lsita prodotta e corretta e non manca niente

Codice: Seleziona tutto
   
For Each Cella In Intervallo
        If WorksheetFunction.CountIf(Origine.Range("A3:A" & Cella.Row), Cella) = 1 Then
            Cella.Copy
            Destinazione.Cells(Y, 3).PasteSpecial
            Destinazione.Cells(Y, 6).Value = Cella.Row
            Y = Y + 1
           
        ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then
            myMatch = Application.Match(Cella.Value, Destinazione.Range("C3:C" & Y), False)
            Destinazione.Cells(myMatch + 2, 6).Value = Destinazione.Cells(myMatch + 2, 6) & " > " & Cella.Row     ' <<< problema all'ultimo ciclo
        End If
    Next Cella
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 28/07/22 13:16

scrive le righe pero poi da Runtime-error 13, come se all'ultimo ciclo mancasse qualcosa (però la lsita prodotta e corretta e non manca niente
C'e' qualcosa di particolare in Origine.A20? Tipo un "errore"

Perche' nell' ElseIf c'e' il controllo che Value <> " " ?

Forse sarebbe meglio controllare che Cella non sia vuota prima di procedere con If WorksheetFunction.CountIf; tipo:
Codice: Seleziona tutto
For Each Cella In Intervallo
    If Cella.Value <> "" Then                                                 'NUOVO IF /END IF
        If WorksheetFunction.CountIf(Origine.Range("A3:A" & Cella.Row), Cella) = 1 Then
           'etc
           'etc
        End If
    End If
Next Cella


Come pure puo' essere prudente inserire la riga che ora va in errore in un ulteriore if:
Codice: Seleziona tutto
        ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then
            myMatch = Application.Match(Cella.Value, Destinazione.Range("C3:C" & Y), False)
            If Not IsError(myMatch) Then                           'ulteriore IF /END IF
                Destinazione.Cells(myMatch, 6).Value = Destinazione.Cells(myMatch, 6) & " > " & Cella.Row
            End If
        End If

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 28/07/22 15:14

ho optato per la soluzione piu prudenet.

un ultima cosa.
volevo rendere dinamico l'intervallo nonsapendo quante ighe mettere ed ho modificato cosi

Codice: Seleziona tutto
Set Intervallo = Origine.Range("A3:" & ActiveSheet.Range("a3").End(xlDown).Address)


però è veramnete lento.. dov'è l'errore?
mi sembra lo stesso codice di sempre..

grazie ancora
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 29/07/22 00:20

Prova con
Codice: Seleziona tutto
Set Intervallo = Origine.Range("A3:" & Origine.Range("a10000").End(xlUp).Address)
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 01/08/22 09:35

questa è bella... ho sistemato la macro, è andata bene, ma solo la PRIMA VOLTA.
poi si ferma dopo 3 righe. Uso la stessa macro per fare un alto check ed anche quella si ferma dopo 4 righe...

sono nel buio piu totale..

Codice: Seleziona tutto
Sub TrovaDoppioni_LoadList()

Dim Cella As Range
Dim Intervallo, Origine, Desinazione As Range


Set Origine = Sheets("Sheet 1")
Set Destinazione = Sheets("Sheet 2")
Set Intervallo = Origine.Range("a3:" & ActiveSheet.Range("a10000").End(xlUp).Address)

Y = 4


    For Each Cella In Intervallo
        If WorksheetFunction.CountIf(Origine.Range("a3:a" & Cella.Row), Cella) = 1 Then
            Cella.Copy
            Destinazione.Cells(Y, 3).PasteSpecial
            Destinazione.Cells(Y, 5).Value = Cella.Row
            Y = Y + 1
           
        ElseIf Origine.Cells(Cella.Row, 8).Value <> " " Then
                myMatch = Application.Match(Cella.Value, Destinazione.Range("C3:C" & Y), False)
                If Not IsError(myMatch) Then
                    Destinazione.Cells(myMatch + 2, 5).Value = Destinazione.Cells(myMatch + 2, 5) & " > " & Cella.Row
                End If
                   
        End If
    Next Cella

End Sub


non vedo errori nel codice.. da cosa puoi dipendere?

grazie,
Ale
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 01/08/22 10:10

errata

Codice: Seleziona tutto
ElseIf Origine.Cells(Cella.Row, 8).Value <> " " Then


corrige
Codice: Seleziona tutto
ElseIf Origine.Cells(Cella.Row, 1).Value <> " " Then

(la condizione di verifica è sempre la colonna 1

scusate la svista
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 01/08/22 10:36

Bravo (anche se hai fatto e disfatto da solo :D )

Io continuo a chiedermi perche' testi Value <> " " Then; vuol dire che le celle vuote sono sempre popolate con "spazio"?
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 01/08/22 10:51

in realta non ho risolto. continua a non andare, come se quando imposto l'intervallo facesse un errore (per me inspiegabile)

Codice: Seleziona tutto
Set Intervallo = Origine.Range("a3:" & ActiveSheet.Range("a10000").End(xlUp).Address)


ho provato a dare un intervallo fisso (H3:H10000) e funziona.

venendo alla tua domanda
Io continuo a chiedermi perche' testi Value <> " " Then; vuol dire che le celle vuote sono sempre popolate con "spazio"?


no in realtà no, voglio solo indicare una cella vuota foser il comando piu corretto è Value <> "" (senza spazio)
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 01/08/22 11:00

Prova con
Codice: Seleziona tutto
    Set Intervallo = Origine.Range("A3:" & Origine.Range("a10000").End(xlUp).Address)

Avevi provato?

E Sì, devi testare <>""
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 01/08/22 12:36

si avevo provato. ma stranamente a volte va, poi si pianta alla 4a riga.
di fatto va ma solo se imposto l'intervallo fisso.



per il secondo punto ok. ho tolto lo spazio.
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42

Re: macro per copiare un elenco senza doppioni

Postdi Anthony47 » 01/08/22 13:20

Hai delle righe vuote all'interno dell'intervallo?
Che significa "si pianta alla 4° riga"? Va in errore, la macro termina e non processa le righe successive, rimane impiccata, ...

Come ultima prova:
Codice: Seleziona tutto
Set Intervallo = Range(Origine.Range("a3"), Origine.Range("a10000").End(xlUp))
Avatar utente
Anthony47
Moderatore
 
Post: 19367
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro per copiare un elenco senza doppioni

Postdi Ale75 » 01/08/22 14:04

cosi funziona. grazie

con "si pianta" intendo che non va oltre la 4 riga (non ci sono anomalie nel file in uso, ne righe vuote), ma alcune volte scorre tutte le righe altre voltre non va piu della 4.

usero il codice sopra.
grazie.
Ale75
Utente Junior
 
Post: 47
Iscritto il: 31/03/17 08:42


Torna a Applicazioni Office Windows


Topic correlati a "macro per copiare un elenco senza doppioni":


Chi c’è in linea

Visitano il forum: Nessuno e 14 ospiti