Unire due liste senza duplicati

Question

Salve,

 Ho un fiel excel con 4 fogli

t1 temporaneo 1

t2 temporaneo 2

r1 risutlato 1

rf risutlato finale

Nella lista t1 ho dei dati codice dream nom e e cognome e lo stesso in t2 (ma i dat idi t1 si possono ripetere in t2)

il codice dream è univoco

Devo cercare i valori di t1 che mancano in t2 e ricavare un unica lista di t2 + t1(senza doppioni) in rf

Io voelvo cercar i dati che mancano da t1 in t2 e scriverli in r1 e poi unire r1 e t2 e ricavare rf...

Come posso risolvere la cosa?

Grazie Mille

https://skydrive.live.com/edit.aspx?cid=9F0EF1CEA0A320F3&resid=9F0EF1CEA0A320F3%21338&app=Excel

https://skydrive.live.com/redir?resid=9F0EF1CEA0A320F3!338&authkey=!ANLPtYON25hW6Ig

non so quale dei due link funzioni

Answer 1

Ciao Lorenzo,

per quanto riguarda il corso di Excel VBA: credo che il corso migliore si possa frequentare visitando assiduamente le pagine di questo forum. Segui le domande, prova a risolverle, confrontati con le risposte date. Se hai voglia e passione non sarà difficile.

La macro che segue popola il foglio r1 con i valori univoci presenti nel foglio t2 rispetto al foglio t1, e il foglio rf con una lista univoca dei valori presenti su entrambi i foglio t1 e t2.

---

Sub ListaUnivoca()

    Dim sh1 As Worksheet

    Dim sh2 As Worksheet

    Dim sh3 As Worksheet

    Dim sh4 As Worksheet

    Dim colR1 As Collection

    Dim colRf As Collection

    Dim varItem As Variant

    Dim lRiga As Long

    Dim i As Long

    With ThisWorkbook

        Set sh1 = .Worksheets("t1")

        Set sh2 = .Worksheets("t2")

        Set sh3 = .Worksheets("r1")

        Set sh4 = .Worksheets("rf")

    End With

    Set colR1 = New Collection

    Set colRf = New Collection

    On Error Resume Next

    With sh2

        lRiga = .Cells(.Rows.Count, 1).End(xlUp).Row

        For i = 2 To lRiga

            colR1.Add .Cells(i, 1).Value & "," & .Cells(i, 2).Value _

                & "," & .Cells(i, 3).Value, CStr(.Cells(i, 1).Value)

            colRf.Add .Cells(i, 1).Value & "," & .Cells(i, 2).Value _

                & "," & .Cells(i, 3).Value, CStr(.Cells(i, 1).Value)

        Next i

    End With

    With sh1

        lRiga = .Cells(.Rows.Count, 1).End(xlUp).Row

        For i = 2 To lRiga

            colR1.Remove CStr(.Cells(i, 1).Value)

            colRf.Add .Cells(i, 1).Value & "," & .Cells(i, 2).Value _

                & "," & .Cells(i, 3).Value, CStr(.Cells(i, 1).Value)

        Next i

    End With

    On Error GoTo 0

    i = 2

    With sh3

        .UsedRange.Resize.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).ClearContents

        For Each varItem In colR1

            .Cells(i, 1).Value = Split(varItem, ",")(0)

            .Cells(i, 2).Value = Split(varItem, ",")(1)

            .Cells(i, 3).Value = Split(varItem, ",")(2)

            i = i + 1

        Next varItem

        .Columns("A:C").AutoFit

    End With

    i = 2

    With sh4

        .UsedRange.Resize.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).ClearContents

        For Each varItem In colRf

            .Cells(i, 1).Value = Split(varItem, ",")(0)

            .Cells(i, 2).Value = Split(varItem, ",")(1)

            .Cells(i, 3).Value = Split(varItem, ",")(2)

            i = i + 1

        Next varItem

        .Columns("A:C").AutoFit

    End With

    Set colR1 = Nothing

    Set colRf = Nothing

    Set sh1 = Nothing

    Set sh2 = Nothing

    Set sh3 = Nothing

    Set sh4 = Nothing

End Sub

---

David

Answer 2

Ciao,

hai visto la mia risposta? C'è una macro che scrive in rf la lista univoca di cui parli.

Per quanto riguarda il risultato in r1, alla macro non serve, nel caso tu ne avessi necessità si può però implementare.

David

Answer 3

 Grazie per le risposte...

i ldiscorso che le liste t1 e t2 cambiano continuamente, e mi serviva proprio una macro o altro metodo, che ogni volta che m iserve facio girare la macro, e ottengo in rs una nuova lista di t1 e t2 unite senza doppioni...

 

Io voelvo cercar i dati che mancano da t1 in t2 e scriverli in r1 e poi unire r1 e t2 e ricavare rf...

 

 

Senza macro ed utilizzando Excel(sempre che abbia capito):

• copia le due tabelle una sotto l'altra in un nuovo foglio
• filtra i dati in modo univoco

 

Per il filtro univoco:

• seleziona la colonna con il codice che deve rimanere univoco
• scheda: Dati
• pulsante: Avanzate
• seleziona: Copia univoca dei record
• Ok

 

Answer 4

 

 

Io voelvo cercar i dati che mancano da t1 in t2 e scriverli in r1 e poi unire r1 e t2 e ricavare rf...

 

 

Senza macro ed utilizzando Excel(sempre che abbia capito):

• copia le due tabelle una sotto l'altra in un nuovo foglio
• filtra i dati in modo univoco

Per il filtro univoco:

• seleziona la colonna con il codice che deve rimanere univoco
• scheda: Dati
• pulsante: Avanzate
• seleziona: Copia univoca dei record
• Ok

Answer 5

Ciao,

un modo potrebbe essere questo:

---

Sub ListaUnivoca()

    Dim sh1 As Worksheet

    Dim sh2 As Worksheet

    Dim sh3 As Worksheet

    Dim colNomi As Collection

    Dim varItem As Variant

    Dim lRiga As Long

    Dim i As Long

    With ThisWorkbook

        Set sh1 = .Worksheets("t1")

        Set sh2 = .Worksheets("t2")

        Set sh3 = .Worksheets("rf")

    End With

    Set colNomi = New Collection

    With sh1

        lRiga = .Cells(.Rows.Count, 1).End(xlUp).Row

        On Error Resume Next

        For i = 2 To lRiga

            colNomi.Add .Cells(i, 1).Value & "," & .Cells(i, 2).Value _

                & "," & .Cells(i, 3).Value, CStr(.Cells(i, 1).Value)

        Next i

    End With

    With sh2

        lRiga = .Cells(.Rows.Count, 1).End(xlUp).Row

        On Error Resume Next

        For i = 2 To lRiga

            colNomi.Add .Cells(i, 1).Value & "," & .Cells(i, 2).Value _

                & "," & .Cells(i, 3).Value, CStr(.Cells(i, 1).Value)

        Next i

    End With

    On Error GoTo 0

    i = 2

    With sh3

        For Each varItem In colNomi

            .Cells(i, 1).Value = Split(varItem, ",")(0)

            .Cells(i, 2).Value = Split(varItem, ",")(1)

            .Cells(i, 3).Value = Split(varItem, ",")(2)

            i = i + 1

        Next varItem

        .Columns("A:C").AutoFit

    End With

    Set colNomi = Nothing

    Set sh1 = Nothing

    Set sh2 = Nothing

    Set sh3 = Nothing

End Sub

---

da incollare in un nuovo modulo

David