比较两个不同的工作簿和突出差异excel vba

Question

所以我想比较两个不同的工作簿在Excel中与VBA。我知道应用程序“比较电子表格”确实存在，但我需要一个通用代码。我在论坛上寻找了很多，试图找到一个解决方案，但没有人符合我的需求。

我想要的是：基本上是一个脚本：要求用户另一个excelfile（file2）与当前文件（file1）进行比较。然后，差异需要在当前文件中突出显示。

我是一种初学者，所以请温和:)我有一些代码，我正在尝试使用，但它只适用于同一工作簿中两张纸的比较。

如果有人得到了一些能够完成这项工作的代码，或者让我更进一步，那么分享代码真的很友善。或者如果你有一些关于如何使代码低于我的需求的提示。非常感谢！！

`Sub test() 

Dim varSheetA As Variant 
Dim varSheetB As Variant 
Dim strRangeToCheck As String 
Dim iRow As Long 
Dim iCol As Long 

strRangeToCheck = "A1:IV65536" 
' If you know the data will only be in a smaller range, reduce the size of the ranges above. 
Debug.Print Now 
varSheetA = Worksheets("Sheet1").Range(strRangeToCheck) 
varSheetB = Worksheets("Sheet 1").Range(strRangeToCheck) ' or whatever your other sheet is. 
Debug.Print Now 

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1) 
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2) 
     If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then 
      'MsgBox ("No difference") 

      ' Cells are identical. 
      ' Do nothing. 
     Else 

      HighlightCells 


      ' Cells are different. 
      ' Code goes here for whatever it is you want to do. 
     End If 
    Next iCol 
Next iRow 

结束子 ' 这是我试图做的，以使作为不同粗体或只是提示用户的部分（一个或多个）所述的修改：

子试验（）

Dim varSheetA As Variant 
Dim varSheetB As Variant 
Dim strRangeToCheck As String 
Dim iRow As Long 
Dim iCol As Long 

strRangeToCheck = "A1:N70" 
' If you know the data will only be in a smaller range, reduce the size of the ranges above. 
Debug.Print Now 
varSheetA = Worksheets("229019_PSS360_17w15").Range(strRangeToCheck) 
varSheetB = Worksheets("229019_PSS360_Ny").Range(strRangeToCheck) ' or whatever your other sheet is. 
Debug.Print Now 

For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1) 
    For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2) 
     If varSheetA(iRow, iCol) <> varSheetB(iRow, iCol) Then 
     Selection.Font.BOLD = True 


     'MsgBox ("diff") 
      ' Cells are identical. 
      ' Do nothing. 
     Else 
     'MsgBox ("same") 
      ' Cells are different. 
      ' Code goes here for whatever it is you want to do. 
     End If 
    Next iCol 
Next iRow 

结束子

Answer 1

使用该代码来提示输入文件开口并打开选中的文件：

Private Sub Open_File(length As Integer) 

    Dim strPath As String 
    Dim temp_workbook As Workbook 
    Dim temp_worksheet As Worksheet 

    Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 
    'make the file dialog visible to the user 
    intChoice = Application.FileDialog(msoFileDialogOpen).Show 
    'determine what choice the user made 
    If intChoice <> 0 Then 
     'get the file path selected by the user 
     strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) 



With CreateObject("Scripting.FileSystemObject") 
      strExt = .GetExtensionName(strPath) 
     End With 

    If StrComp(strExt, "xlsx", vbTextCompare) = 0 Or StrComp(strExt, "xlsm", vbTextCompare) = 0 Or StrComp(strExt, "xls", vbTextCompare) = 0 Then 
     Else 
     ' Display error 
    MsgBox ("Wrong file format. Accepted formats are .xlsx and .xlsm") 
     Exit Sub 
    End If 

End If 

If intChoice <> -1 Then 
    If MsgBox("Cancel operation?", vbYesNo, "Confirmation") = vbYes Then 
     Exit Sub 
    Else 
     Open_File (length) 
    End If 
End If 
Set temp_workbook = Workbooks.Open(strPath, True, True) 
Set temp_worksheet = Sheets(1) 
End Sub 

在本小节结束时，您将要求用户选择一个文件，并且您将打开所述文件（确保它是事先的Excel文件）。 此时您想要做的是将temp_worksheet中的数据复制到variant中，并将其值与来自源表单（您正在比较的数据表）中的值进行比较，该数据表也将储存在variant array：

Dim strArray() As Variant 
Dim strArray2() As Variant 

strArray = SourceSheet.Range(YourRangeHere) 
strArray2 = temp_worksheet.Range(YourSecondRangeHere) 

此时，您只需循环访问数组并相应地比较值。一旦发现差异，您可以突出显示相应工作表中的差异。我会让你指出最后一部分，但它非常简单。如果您需要了解数据如何存储在strArray和strArray2中，只需在您的代码中定义一个断点并运行，然后添加一个间谍（选择strArray，右键单击并“添加间谍”）以实时查看这些值。 祝你好运！