比較兩個不同的工作簿和突出差異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，右鍵單擊並「添加間諜」）以實時查看這些值。 祝你好運！