比较两个excel文件vba

Question

寻找一个VBA代码，我可以从两个不同的excel文件中比较数据，并在第三个excel文件中添加输出。

文件可以包含N列和N行，它必须验证。

1. 我得到了一个代码来比较2页，但我需要输出如下。(此vba代码将打开excel文件读取数据)比较
后的数据输出

Sub Compare()
Dim WorkRng1 As Range, WorkRng2 As Range, Rng1 As Range, Rng2 As Range
Set objWorkbook1 = Workbooks.Open("F:LearningBook1.xlsx")
Set objWorkbook2 = Workbooks.Open("F:LearningBook2.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

需要这样的输出

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. 其他代码不打开文件，但我需要比较数据并获得如上的输出。

Excel File 1 | Excel File 2 |输出文件

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:LearningBook1.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:LearningBook2.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

输出文件包含供参考使用的VBA代码。

也许读一个和上面的excel文件一样的txt文件会很好。

Answer 1

试试这个

你需要一个名为"Compare"在运行代码的工作簿中。

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:LearningBook1.xlsx").Worksheets(1).UsedRange
Set Rng2 = Workbooks.Open("F:LearningBook2.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