比較2個excel工作簿中的數據（未排序的數據）

Question

我在比較2個工作簿中的數據，列標題的順序相同，它們是：ID，DepartmentName，Name，SalesAmount，StartDate，End Date。

當前我正在比較工作表1中的所有單元格到工作表2（例如：工作表1中的單元格A1到工作表2中的單元格A1）。但是，現在工作表2中的數據採用了不同的順序，因此我目前的比較方法不起作用。

如果工作表1包含正確的數據，我希望能夠將正確的行匹配到工作表2並檢查數據是否匹配。對於表2中不存在的行，會顯示一張表來通知我缺少哪些ID。與之相比細胞與細胞和

代碼標識的差異：

For Each mycell In ActiveWorkbook.Worksheets(shtSheet2).UsedRange 
    If Not mycell.Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(mycell.Row, mycell.Column).Value Then   
     mycell.Interior.Color = vbRed 
     difference = difference + 1 
    End If 
Next 

任何建議或幫助將不勝感激！謝謝

Answer 1

您應該讀取「好」的ID列表，併爲每個人使用Range.Find方法來查找shtSheet2中的條目。如果未找到，請將「良好」交易數據複製到輸出表。如果找到，則循環比較它們的數據項。這裏的代碼：

Dim sourceId As Range 
Dim testIdData As Range 
Dim outputRange As Range 
Dim cellFound As Range 
Dim columnNum As Integer 
Dim copyTheData As Boolean 
Dim difference As Integer 

Const NUM_COLUMNS_DATA As Integer = 6 ' 

    ' Assumes that worksheet variables are already defined 
    Set sourceId = ActiveWorkbook.Worksheets(shtSheet1).Range("A1") 
    Set testIdData = ActiveWorkbook.Worksheets(shtSheet2).Range("A1") 
    Set outputRange = ActiveWorkbook.Worksheets(shtSheet3).Range("A1") 

    ' Extend testIdData to cover all rows of data 
    Set testIdData = testIdData.Resize(testIdData.CurrentRegion.Rows.Count) 

    Do Until sourceId.Value = "" 
     copyTheData = False 
     ' Look for ID in test data 
     Set cellFound = testIdData.Find(What:=sourceId.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) 
     If cellFound Is Nothing Then 
      ' This entry not found, so copy to output 
      copyTheData = True 
      outputRange.Resize(ColumnSize:=NUM_COLUMNS_DATA).Interior.Color = vbRed 
     Else 
      ' Test that all the items match 
      ' This assumes that columns are in same order 
      For columnNum = 2 To NUM_COLUMNS_DATA ' No need to test the ID column 
       If sourceId.Cells(ColumnIndex:=columnNum).Value <> cellFound.Cells(ColumnIndex:=columnNum).Value Then 
        outputRange.Cells(ColumnIndex:=columnNum).Interior.Color = vbRed 
        copyTheData = True 
       End If 
      Next columnNum 
     End If 
     If copyTheData Then 
      sourceId.Resize(ColumnSize:=NUM_COLUMNS_DATA).Copy 
      ' Do PasteSpecial to avoid over-writing the ".Interior.Color = vbRed" 
      outputRange.PasteSpecial xlPasteValuesAndNumberFormats 
      Application.CutCopyMode = False 
      Set outputRange = outputRange.Offset(RowOffset:=1) 
      difference = difference + 1 
     End If 
     Set sourceId = sourceId.Offset(RowOffset:=1) 
    Loop 

記住在真實數據上使用它之前要徹底地測試它。