confrontare dati di 2 file excel

Question

Sono un ignorante di excel..tranne l abc, per cui se potete spiegatemi come fossi un novantenne . Ho 2 file excel il primo con 3000 prodotti nella prima colonna ho i codici numerici che identificano univocamente i prodotti poi ho 3 colonne di dati; nel secondo foglio ho circa 1000 prodotti e la struttura è la stessa, alcuni protti sono presenti in entrambi i file. Vorrei ottenere 1)una tabella con i prodotti presenti in entrambi i file e 2) una tabella contenente tutti i prodotti del primo file - quelli eventualmente presenti nel secondo . Grazie in anticipo

Answer 1

Ciao Marco,

Prova quanto segue:

• Alt-F11 per aprire l'editor di VBA
• Alt-IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim srcWB As Workbook, srcWB2 As Workbook, destWB As Workbook

    Dim srcSH As Worksheet, srcSH2 As Worksheet, destSH As Worksheet

    Dim srcRng As Range, srcRng2 As Range

    Dim destRng As Range, destRng2 As Range

    Dim arrIn As Variant, arrIn2 As Variant

    Dim arrKeys As Variant, arrKeys2 As Variant

    Dim oDic As Object, aDic As Object, bDic As Object

    Dim iRow As Long, jRow As Long

    Dim i As Long, j As Long, k As Long

    Dim sStr As String

    Const sFile = "C:\Pippo\Marco1.xlsx"                                                   '<<==== Modifica[1]

    Const sFile2 = "C:\Pippo\Marco2.xlsx"                                               '<<==== Modifica[2]

    Const sFoglio As String = "Prodotti"                                                     '<<==== Modifica[3]

    Const sFoglio2 As String = "Prodotti2"                                                 '<<==== Modifica[4]

    Const sFoglio3 As String = "Report"                                                     '<<==== Modifica[5]

    Application.ScreenUpdating = False

    Set destWB = ThisWorkbook

    Set srcWB = Workbooks.Open(sFile)

    Set srcWB2 = Workbooks.Open(sFile2)

    Set srcSH = srcWB.Sheets(sFoglio)

    Set srcSH2 = srcWB2.Sheets(sFoglio2)

    With srcSH

        iRow = LastRow(srcSH, .Columns("A:A"))

        Set srcRng = .Range("A2:A" & iRow)

    End With

    With srcSH2

        jRow = LastRow(srcSH2, .Columns("A:A"))

        Set srcRng2 = .Range("A2:A" & jRow)

    End With

    arrIn = srcRng.Value

    arrIn2 = srcRng2.Value

    srcWB.Close SaveChanges:=False

    srcWB2.Close SaveChanges:=False

    Set oDic = CreateObject("Scripting.Dictionary")

    Set aDic = CreateObject("Scripting.Dictionary")

    Set bDic = CreateObject("Scripting.Dictionary")

    On Error Resume Next

    For i = 1 To UBound(arrIn, 1)

        sStr = arrIn(i, 1)

        oDic.Add Item:=sStr, key:=sStr

    Next i

    On Error GoTo 0

    On Error Resume Next

    For j = 1 To UBound(arrIn2, 1)

        sStr = arrIn2(j, 1)

        oDic.Add Item:=sStr, key:=sStr

        aDic.Add Item:=sStr, key:=sStr

    Next j

    On Error GoTo 0

    arrKeys = oDic.keys

    For k = 0 To UBound(arrKeys)

        If aDic.exists(arrKeys(k)) Then

            oDic.Remove (arrKeys(k))

        End If

    Next k

    arrKeys2 = oDic.keys

    Set destSH = destWB.Sheets(sFoglio3)

    With destSH

        With .Range("A1")

            .Value = "Tabella1"

            .Offset(1).Resize(UBound(arrKeys) + 1).Value = _

                                    Application.Transpose(arrKeys)

        End With

        With .Range("C1")

            .Value = "Tabella2"

            .Offset(1).Resize(UBound(arrKeys2) + 1).Value = _

                                    Application.Transpose(arrKeys2)

        End With

    End With

XIT:

    Application.ScreenUpdating = True

    Set oDic = Nothing

    Set aDic = Nothing

    Set bDic = Nothing

End Sub

'--------->>

Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

• Alt-Q per chiudere l'editor di VBA e tornare a Excel.
• Alt-F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Nel codice:

 [1] sostituisci C:\Pippo\Marco1.xlsxcon il percorso e il nome del tuo primo file;

 [2] sostituisci C:\Pippo\Marco2.xlsxcon il percorso e il nome del tuo secondo file;

 [3] sostituisci Prodotti ****con il nome del foglio interessato del primo file;

 [4] sostituisci Prodotti ****con il nome del foglio interessato del secondo file;

 [5] sostituisci Reportcon il nome del foglio su cui le due tabelle dovrebbero essere copiate.

===

Regards,

Norman