Confrontare 2 file e verificare le corrispondenze di alcune colonne.

Question

Buona sera a tutti.

Giorni fa con l'aiuto del grande Norman, sono riuscito ad automatizzare l'acquisizione di alcuni dati da un file aperto con Filedialog ed incollarli in un altro che viene completato con altre routine vba.

I 2 files per i quali chiedo il vostro aiuto sono formattati nello stesso modo, i dati sono riportati nelle colonne A:K  come potete notare dall'immagine postata. 

 

Ho la necessità, con il vostro aiuto, di poter creare una routine che faccia questo:

1. mi controlli i dati delle colonne C:E del Foglio1 del file A con le rispettive colonne del primo foglio del File B ( questo è in un'altra directory e cartella);
2. Mi segnali tramite MSGBOX se non ci sono dati differenti ( tipo: Dal confronto dei 2 files non ci sono dati discordanti, tutto è a posto);
3. in caso di dati discordanti, salvarli tutti in un file di Excel con directory scelta da Filedialog;

Spero di essere stato chiaro.

Ringrazio chi mi aiuta in questo.

Ciao Nicola.

Answer 1

Ciao Nicola,

Ti allego i 2 file al seguente link:

https://1drv.ms/u/s!Ali6qqOH3dOAk0tStXKBS4rxqddq?e=5acd9z

Il File1 è quello dal quale dovrei lanciare la routine per il confronto dei dati del File2 che sitrova in questo percorso : C:\Pagamenti\   ed il file originale si chiama Pagamenti.xlsx

Alla riga 8 del File 2 hai un nominativo in verde che non è presente nel File1, quindi dovrebbe essere evidenziato come differenze.

P.S. ho riprodotto il mio scenario con dati non sensibili nei 2 files.

Prova qualcosa del genere:

'========>>

Option Explicit

Dim RngDiscordante As Range

'-------->>

Public Sub Tester()

    Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook

    Dim SH1 As Worksheet, SH2 As Worksheet

    Dim Rng1 As Range, Rng2 As Range, RngTemp As Range

    Dim vArr1() As Variant, vArr2() As Variant

    Dim vFileName As Variant

    Dim sFileType As String

    Dim sTitle As String

    Dim iFilterIndex As Long

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

    Dim iRow As Long, jRow As Long

    Dim UB As Long, UB2 As Long

    Dim bMatch As Boolean

    Const sColonneDaConfrontare As String = "C:E"         

    Const sPercorso As String = "C:\Pagamenti\Pagamenti.xlsx"

    Set WB1 = ThisWorkbook

    Set SH1 = WB1.Sheets(1)

    Set WB2 = Application.Workbooks.Open(sPercorso)

    Set SH2 = WB2.Sheets(1)

    iRow = LastRow(SH1, SH1.Range(sColonneDaConfrontare))

    Set Rng1 = SH1.Columns(sColonneDaConfrontare).Resize(iRow)

    Set Rng2 = SH2.Range(Rng1.Address)

    vArr1 = Rng1.Value2

    vArr2 = Rng2.Value2

    UB = UBound(vArr1)

    UB2 = UBound(vArr1, 2)

    ReDim Preserve vArr2(1 To UB, 1 To UB2 + 1)

    Set RngDiscordante = Nothing

    For i = 2 To UB

        For j = 2 To UB

            For k = 1 To UB2

                bMatch = vArr2(i, k) = vArr1(j, k)

                If bMatch = False Then

                    Exit For

                End If

            Next k

            If bMatch = True Then Exit For

        Next j

        If bMatch = False Then

            Call MakeRange(SH2.Rows(i))

        End If

    Next i

    If Not RngDiscordante Is Nothing Then

        sFileType = "File Excel (*.xls*),*.xls*,"

        sTitle = "Seleziona il file in cui si deve riportare i dati discordanti"

        vFileName = Application.GetOpenFilename(sFileType, _

            iFilterIndex, sTitle, MultiSelect:=False)

        If vFileName = False Then

            Call MsgBox(Prompt:="Non hai selezionato un file da riportare!", _

            Title:="REPORT", _

            Buttons:=vbCritical)

            Exit Sub

        End If

        Set WB3 = Application.Workbooks.Open(vFileName)

        RngDiscordante.Copy Destination:=WB3.Sheets(1).Range("A2")

    End If

    WB2.Close SaveChanges:=False

    Call MsgBox(Prompt:="Fatto", _

    Buttons:=vbInformation, _

    Title:="REPORT")

End Sub

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

Public Sub MakeRange(rRow As Range)

    If Not RngDiscordante Is Nothing Then

        Set RngDiscordante = Union(RngDiscordante, rRow)

    Else

        Set RngDiscordante = rRow

    End If

End Sub

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

Public Function LastRow(SH As Worksheet, _

    Optional rng As Range, _

    Optional minRow As Long = 1)

    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

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========

===

Regards,

Norman

Answer 2

Buongiorno Norman, grazie mille per il tuo impegno. Sono al lavoro, proverò la tua routine stasera, a casa. Ti rinnovo il mio più sincero ringraziamento. Ciao Nicola.

Answer 3

Ciao Nicola,

Ciao Norman, grazie come sempre per la tua attenzione ed il tuo cortese riscontro.

Quanto a questo:

Una domanda mia: la riga x del primo file deve corrispondere con la stessa riga del secondo file?

No, potrebbero essere righe diverse tra i due Files, però i dati sono uguali per numero di righe e  di colonne e la routine dovrebbe verificare che non ci siano dati diversi tra i 2 files.

Quindi, stessi dati ma in righe diverse.

Spero di essere stato chiaro Norman, diversamente chiedimi altre info.

P.S: Norman  ti aggiungo inoltre che la routine la dovrei lanciare dal Foglio1 del file A aperto e su cui posiziono il command button.

Prova qualcosa del genere:

'========>>

Option Explicit

Dim RngDiscordante As Range

'-------->>

Public Sub Tester()

    Dim WB1 As Workbook, WB2 As Workbook, WB3 As Workbook

    Dim SH1 As Worksheet, SH2 As Worksheet

    Dim Rng1 As Range, Rng2 As Range, RngTemp As Range

    Dim vArr1() As Variant, vArr2() As Variant

    Dim vFileName As Variant

    Dim vRow As Variant

    Dim sFileType As String

    Dim sTitle As String

    Dim sCreditore As String

    Dim iFilterIndex As Long

    Dim i As Long, j As Long

    Dim iRow As Long, jRow As Long

    Dim UB As Long, UB2 As Long

    Dim bDiscordante As Boolean

    Const sColonneDaConfrontare As String = "C:E"                '<<=== Modifica

    sFileType = "File Excel (*.xls*),*.xls*,"

    sTitle = "Selezionare il file da confrontare"

    vFileName = Application.GetOpenFilename(sFileType, _

        iFilterIndex, sTitle, MultiSelect:=False)

    If vFileName = False Then

        Call MsgBox(Prompt:="Non hai selezionato un file da confrontare!", _

        Title:="REPORT", _

        Buttons:=vbCritical)

        Exit Sub

    End If

    Set WB1 = ThisWorkbook

    Set SH1 = WB1.Sheets(1)

    Set WB2 = Application.Workbooks.Open(vFileName)

    Set SH2 = WB2.Sheets(1)

    iRow = LastRow(SH1, SH1.Range(sColonneDaConfrontare))

    Set Rng1 = SH1.Columns(sColonneDaConfrontare).Resize(iRow)

    Set Rng2 = SH2.Range(Rng1.Address)

    vArr1 = Rng1.Value2

    vArr2 = Rng2.Value2

    UB = UBound(vArr1)

    UB2 = UBound(vArr1, 2)

    ReDim Preserve vArr2(1 To UB, 1 To UB2 + 1)

    For i = 2 To UB

        sCreditore = vArr1(i, 2)

        bDiscordante = False

        Dim arrCreditori As Variant

        arrCreditori = Application.Index(vArr2, 0, 2)

        vRow = Application.Match(sCreditore, arrCreditori, 0)

        If Not IsError(vRow) Then

            For j = 1 To UB2

                If vArr2(vRow, j) <> vArr1(i, j) Then

                    Set RngTemp = Rng2.Rows(vRow).EntireRow.Resize(1, 5)

                    Call MakeRange(RngTemp)

                    Exit For

                End If

            Next j

        End If

    Next i

    If Not RngDiscordante Is Nothing Then

        sTitle = "Seleziona il file in cui si deve riportare i dati discordanti"

        vFileName = Application.GetOpenFilename(sFileType, _

            iFilterIndex, sTitle, MultiSelect:=False)

        If vFileName = False Then

            Call MsgBox(Prompt:="Non hai selezionato un file da riportare!", _

            Title:="REPORT", _

            Buttons:=vbCritical)

            Exit Sub

        End If

        Set WB3 = Application.Workbooks.Open(vFileName)

        RngDiscordante.Copy Destination:=WB3.Sheets(1).Range("A2")

    Else

        Call MsgBox(Prompt:="Dal confronto dei 2 files non ci sono dati discordanti, tutto è a posto", _

        Buttons:=vbInformation, _

        Title:="Tutto a posto!")

    End If

    WB2.Close SaveChanges:=False

    Call MsgBox(Prompt:="Fatto!", _

    Title:="REPORT", _

    Buttons:=vbInformation)

End Sub

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

Public Sub MakeRange(rRow As Range)

    If Not RngDiscordante Is Nothing Then

        Set RngDiscordante = Union(RngDiscordante, rRow)

    Else

        Set RngDiscordante = rRow

    End If

End Sub

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

Public Function LastRow(SH As Worksheet, _

    Optional rng As Range, _

    Optional minRow As Long = 1)

    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

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========

===

Regards,

Norman

Answer 4

Ciao Norman, grazie come sempre per la tua attenzione ed il tuo cortese riscontro.

Quanto a questo:

Una domanda mia: la riga x del primo file deve corrispondere con la stessa riga del secondo file?

No, potrebbero essere righe diverse tra i due Files, però i dati sono uguali per numero di righe e  di colonne e la routine dovrebbe verificare che non ci siano dati diversi tra i 2 files.

Quindi, stessi dati ma in righe diverse.

Spero di essere stato chiaro Norman, diversamente chiedimi altre info.

P.S: Norman  ti aggiungo inoltre che la routine la dovrei lanciare dal Foglio1 del file A aperto e su cui posiziono il command button.

Ciao Nicola.

Answer 5

Ciao Nicola,

Giorni fa con l'aiuto del grande Norman, sono riuscito ad automatizzare l'acquisizione di alcuni dati da un file aperto con Filedialog ed incollarli in un altro che viene completato con altre routine vba.

I 2 files per i quali chiedo il vostro aiuto sono formattati nello stesso modo, i dati sono riportati nelle colonne A:K  come potete notare dall'immagine postata. 

 

Ho la necessità, con il vostro aiuto, di poter creare una routine che faccia questo:

1. mi controlli i dati delle colonne C:E del Foglio1 del file A con le rispettive colonne del primo foglio del File B ( questo è in un'altra directory e cartella);
2. Mi segnali tramite MSGBOX se non ci sono dati differenti ( tipo: Dal confronto dei 2 files non ci sono dati discordanti, tutto è a posto);
3. in caso di dati discordanti, salvarli tutti in un file di Excel con directory scelta da Filedialog;

Una domanda mia: la riga x del primo file deve correspondere con la stessa riga del secondo file?

===

Regards,

Norman