Comparer deux fichiers Excel en vba

Question

Je recherche un code VBA qui me permette de comparer les données de deux fichiers Excel différents et d'ajouter la sortie dans le troisième fichier Excel.

Le fichier peut contenir un nombre N de colonnes et un nombre N de lignes qu'il doit valider.

1. J'ai un code pour comparer 2 feuilles mais j'ai besoin d'une sortie comme ci-dessous. (ce code vba va ouvrir le fichier excel pour lire les données) Sortie des données après comparaison

Sub Compare()

Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range

Set objWorkbook1 = Workbooks.Open("F:\Learning\Book1.xlsx")
Set objWorkbook2 = Workbooks.Open("F:\Learning\Book2.xlsx")

Set objWorksheet1 = objWorkbook1.Worksheets(1)
Set objWorksheet2 = objWorkbook2.Worksheets(1)

Set WorkRng1 = objWorksheet1.UsedRange
Set WorkRng2 = objWorksheet2.UsedRange

For Each Rng1 In WorkRng1
    Rng1.Value = Rng1.Value
    For Each Rng2 In WorkRng2
        If Rng1.Value = Rng2.Value Then

            Exit For
        End If
    Next
Next

End Sub

Sortie requise comme ceci

Name_Book1    | Name_Book2 |  Compare |   Amount_book1 |  Amount_book2|   Compare 
Store_1       | Store_1    | Pass     | 362            | 420           | Fail
Store_2       | Store_2    | Pass     | 400            | 360           |Fail
Store_3       | Store_3    | Pass     | 922            | 520           | Fail
Store_4       | Store_4    | Pass     | 600            | 320           | Fail
Store_5       | Store_5    | Pass     | 400            | 400           | Pass

2. L'autre code n'ouvre pas le fichier mais je dois comparer les données et obtenir la sortie comme ci-dessus.

Fichier Excel 1 | Fichier Excel 2 | Fichier de sortie

Sub GetDataFromSingleCell(cell As String)

Dim srcCN As Object ' ADODB.Connection
Dim srcRS As Object ' ADODB.Recordset

Set srcCN = CreateObject("ADODB.Connection")
Set srcRS = CreateObject("ADODB.Recordset")

srcCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & CStr("F:\Learning\Book1.xlsx") & _
            ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"

srcRS.Open "SELECT * FROM [Sheet1$" & cell & ":" & cell & "];", srcCN, 3, 1  'adOpenStatic, adLockReadOnly

srctxt = srcRS.Fields(0).Value

Dim trgCN As Object ' ADODB.Connection
Dim trgRS As Object ' ADODB.Recordset

Set trgCN = CreateObject("ADODB.Connection")
Set trgRS = CreateObject("ADODB.Recordset")

trgCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & CStr("F:\Learning\Book2.xlsx") & _
            ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"

trgRS.Open "SELECT * FROM [Sheet1$" & cell & ":" & cell & "];", trgCN, 3, 1  'adOpenStatic, adLockReadOnly

trgtxt = trgRS.Fields(0).Value

If srctxt = trgtxt Then
    Sheet1.Cells(1, 2) = "Passed"
Else
    Sheet1.Cells(1, 2) = "Failed"
End If

End Sub

Le fichier de sortie contient le code VBA pour l'utilisation des références.

Peut-être que lire un fichier txt comme un fichier excel comme ci-dessus serait bien.

Answer 1

Essayez ça.

Vous aurez besoin d'une feuille nommée "Compare" dans le classeur où le code est exécuté.

Sub Compare()

    Dim Rng1 As Range, Rng2 As Range, arr1, arr2, arrOut
    Dim rw As Long, col As Long, c As Long, v1, v2

    'open workbooks and assign ranges  
    Set Rng1 = Workbooks.Open("F:\Learning\Book1.xlsx").Worksheets(1).UsedRange
    Set Rng2 = Workbooks.Open("F:\Learning\Book2.xlsx").Worksheets(1).UsedRange

    'check ranges are comparable 
    If Rng1.Rows.Count <> Rng2.Rows.Count Or _
       Rng1.Columns.Count <> Rng2.Columns.Count Then
        MsgBox "Ranges are different sizes!"
        Exit Sub
    End If

    'faster to read from arrays...
    arr1 = Rng1.Value
    arr2 = Rng2.Value
    'size array for output (need 3 output columns per input column)
    ReDim arrOut(1 To UBound(arr1, 1), 1 To 3 * UBound(arr1, 2))

    For rw = 1 To UBound(arr1, 1)
        c = 1 'start column position in output array
        For col = 1 To UBound(arr1, 2)
            v1 = arr1(rw, col)
            v2 = arr2(rw, col)
            If rw = 1 Then
                'column headers here...
                arrOut(rw, c) = v1 & "_book1"
                arrOut(rw, c + 1) = v2 & "_book2"
                arrOut(rw, c + 2) = "Compare"
            Else
                'column values comparison
                arrOut(rw, c) = v1
                arrOut(rw, c + 1) = v2
                arrOut(rw, c + 2) = IIf(v1 = v2, "Pass", "Fail")
            End If
            c = c + 3
        Next col
    Next rw

    'put result array on worksheet
    With ThisWorkbook.Sheets("Compare")
        .UsedRange.ClearContents
        .Range("A1").Resize(UBound(arrOut, 1), UBound(arrOut, 2)).Value = arrOut
    End With

End Sub