比較兩個excelsheets基於公共'id'字段（列）

Question

比較兩個excelsheets在同一工作簿中。

我要檢查從Sheet1記錄是否在Sheet2中記錄的基礎上共同Question_id（包括工作表的列A）

這question_id（列）完全相同具有值，如

1 
    1a 
    1a.1 
    1a.1a 
    1a.1b 
    1a.1c 
    2 
    2a 
    2a.1 
    2a.1a 
    2a.1b 
    2a.1c etc.... 

我想比較基於此Question_id（列A值）的記錄。

如果Question_id是相同的，並且記錄（剩餘行）不一樣，然後我在着色紅色背景的記錄（僅適用於特定的細胞，而不是整個行）

出於同樣的，我有以下的代碼。

Sub RunCompare() 

    Call compareSheets("Sheet1", "Sheet2") 

End Sub 


Sub compareSheets(shtSheet1 As String, shtSheet2 As String) 

Dim mycell As Range 
Dim mydiffs As Integer 

    Application.ScreenUpdating = false 

    'Color Uncommon records in Red Background 
    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 
      mydiffs = mydiffs + 1 

     End If 
    Next 

    'Display no. of differences 
    MsgBox mydiffs & " differences found", vbInformation 

    ActiveWorkbook.Sheets(shtSheet2).Select 


    MsgBox "Data Scrubbed Successfully..." 
    Application.ScreenUpdating = True 
End Sub 

上面的代碼運行正常時，我有在兩個excelsheets Question_id（和因此的記錄）的相同序列。

假設我在兩張表中都有不同順序的Question_id（以及記錄）。

那麼我該如何實現這個......？

像在我的代碼使用where子句Where Sheet1.Question_id = Sheet2.Question_id

即我從工作表Sheet1只有拿起question_id和全行，我會根據匹配Question_id（A列的值），對比較Sheet2中記錄。

有人可以告訴我哪裏可以放置條件和什麼類型的條件，即使這兩個excelsheets都有隨機序列的Question_id;我將能夠比較sheet1和sheet2中的記錄。

編輯：於2015年3月23日

我已經改變了使用代碼find（）方法，而不是下面的循環： 不過我在解決方案沒有帶到達。 這裏我試圖列出從Sheet2的工作表Sheet 3中的所有不匹配行的Question_Ids - 列A.

Option Explicit 

Sub test() 

    Dim rng As Range, c As Range, cfind As Range, mycell As Range, cfindRow As Range 

    On Error Resume Next 

    Worksheets("Sheet3").Cells.Clear 

    With Worksheets("Sheet2") 
     Set rng = .Range(.Range("A2"), .Range("a2").End(xlDown)) 

     For Each c In rng 
     With Worksheets("Sheet1") 
      Set cfind = .Columns("A:A").Cells.Find _ 
      (what:=c.Value, lookat:=xlWhole) 

      'Find method always returns Range; So the following line should be something If cfind is not Nothing OR cfind <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please. 
      If cfind = 1 Then 
      'Here please tell me how to reference a whole row based on Column A value 
      'Here using cfind and again using mycell is something wrong as mycell variable again compares rows in sheet2 with rows in sheet1 which include Question_Id too. 

      Set mycell = ActiveWorkbook.Worksheets("Sheet2").UsedRange.End(xlDown) 
      'My both the excelsheets have values from columns A to AD. Still I want to make the code for all used Ranges of columns instead of only A to AD. 
      Set cfindRow = Worksheets("Sheet1").Rows("A2:AD").Cells.Find _ 
      (what:=mycell.Value, lookat:=xlWhole) 


      'Find method always returns Range; So the following line should be something If cfindRow is not Nothing OR cfindRow <> Nothing (Both the syntaxes are wrong. Suggest me the right syntax please. 

      If cfindRow = 1 Then 
      'MsgBox "Match Found" 'Right Now do Nothing 
      End If 
      Else 

      ' mycell.Interior.Color = vbRed 
      ' mydiffs = mydiffs + 1 


      'Copy the question numbers to sheet3 either if they are new in new sheet (Sheet2) or content against them (in the whole row-any column value) is changed. 
      cfind.Copy Worksheets("sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 


      End If 
     End With 
     Next c 
     Application.CutCopyMode = False 
    End With 


    MsgBox "Data Scrubbed Successfully..." 
End Sub 

誰能告訴我如何引用基於鍵列值的範圍是多少？

我對解決方案的新方法：

（It may be a hint to give me answer on how to reference Row values based on key column）

Getting row indices of both the sheets; column A values (Question_Id's) i.e.

c.Row and cfind.Row

Then

Check If(Sheet2.Cells(c.Row, Columns) = Sheet1.Cells(cfind.Row, Columns) (To compare columns against matching Question_Ids only.)

所以最後這個什麼都試圖實現：

1）比較基於鍵列兩頁：

從Sheet2 - 列A中提取Question_Id，並將其與列A在Sheet1中。如果來自兩張圖紙的關鍵列匹配，並且與它們對應的內容（完整行）匹配 - 則不執行任何操作。

如果鍵列值（Question_Id - 列A）的比賽，但反對它的值（行）不符合他們的顏色特定細胞（僅細胞），而不是整個行中紅色背景。

2）在sheet2中存在但不在sheet1中的Question_Id應該列在sheet3的第一列下。從A2開始。

3）在sheet1中有但是在sheet2中沒有的Question_Id應該在sheet3的第二列下面列出。從B2開始。

Answer 1

我立足我的代碼了你的第一種方法，因爲我發現它比第二種方法更簡單，更具可讀性。

我們只是做最樸素的算法，即遍歷兩個工作表使用範圍中的每一行。 （最快的算法很可能會在內存中兩個區域進行排序，然後進行比較，但現在的代碼在性能優化的簡單。）

Sub compareSheets(shtSheet1 As String, shtSheet2 As String) 
    Dim range1 As Range, range2 as Range 
    Dim mydiffs As Integer, row1 As Integer, row2 As Integer, col As Integer 
    Application.ScreenUpdating = False 

    'First create the two ranges we will be using 
    Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange 
    Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange 

    'Iterate through the rows of both ranges 
    For row1 = 1 To range1.Rows.Count 
     For row2 = 1 To range2.Rows.Count 

      'Only process the ranges if they share a common key in column 1 
      If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then 

       'If they share the same key, iterate through columns and compare 
       For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count) 
        If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then 
         range1.Cells(row1, col).Interior.Color = vbRed 
         range2.Cells(row2, col).Interior.Color = vbRed 
         mydiffs = mydiffs + 1 
        End If 
       Next 

      End If 

     Next 
    Next 

    'Display no. of differences 
    MsgBox mydiffs & " differences found", vbInformation 

    Application.ScreenUpdating = True 
End Sub 

有一些規格我不知道的。例如，如果一個密鑰在一個電子表格中而不是另一個電子表格中，那該怎麼辦它應該在它存在的工作表中被塗成紅色嗎？儘管如此，我認爲上面的代碼應該給你一個很好的開始，以解決你的更概念性的問題，我很樂意根據需要進行調整，所以請評論是否有我缺少的具體要求。

更新1

這是我們在聊天（評論中的鏈接）的討論，這需要從完整外無與倫比的按鍵加入，並將它們複製到第三片之後的被更新的代碼。

Sub compareSheets(shtSheet1 As String, shtSheet2 As String, shtSheet3 As String) 
    Application.ScreenUpdating = False 

    Dim range1 As Range, range2 As Range 
    Dim myDiffs As Integer, row1 As Integer, row2 As Integer, col As Integer 
    Dim sheet3index1 As Integer, sheet3index2 As Integer, i As Integer 

    Dim leftKeyMatched As Boolean 'Boolean to keep track of whether the key in sheet1 has a match as we are looping 
    Dim rightKeysMatched() As Boolean 'Array to keep track of which keys in sheet2 have matches 

    Set range1 = ActiveWorkbook.Worksheets(shtSheet1).UsedRange 
    Set range2 = ActiveWorkbook.Worksheets(shtSheet2).UsedRange 

    ReDim rightKeysMatched(range2.Rows.Count) 

    For row1 = 1 To range1.Rows.Count 
     leftKeyMatched = False 
     For row2 = 1 To range2.Rows.Count 

      If range1.Cells(row1, 1) = range2.Cells(row2, 1) Then 
       'We have a match, so mark both sides as matched 
       leftKeyMatched = True 
       rightKeysMatched(row2 - 1) = True 'This -1 is because the array indexing starts at 0 but the rows in the spreadsheet start at 1 

       For col = 1 To WorksheetFunction.Max(range1.Columns.Count, range2.Columns.Count) 
        If Not range1.Cells(row1, col).Value = range2.Cells(row2, col).Value Then 
         range1.Cells(row1, col).Interior.Color = vbRed 
         range2.Cells(row2, col).Interior.Color = vbRed 
         myDiffs = myDiffs + 1 
        End If 
       Next 
      End If 
     Next 

     'Print out the key from sheet1 if it didn't find a match in sheet2 
     If leftKeyMatched = False Then 
      sheet3index1 = sheet3index1 + 1 
      ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index1, 1) = range1.Cells(row1, 1) 
     End If 
    Next 

    'Now print out any key that still hasn't been matched in sheet2 
    For i = 0 To range2.Rows.Count 
     If rightKeysMatched(i) = False Then 
      sheet3index2 = sheet3index2 + 1 
      ActiveWorkbook.Worksheets(shtSheet3).Cells(sheet3index2, 2) = range2.Cells(i + 1, 1) '+1 for same reason as above, index starts at 0 versus 1 
     End If 
    Next 

    'Display no. of differences 
    'MsgBox myDiffs & " differences found", vbInformation 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

如果你想找到一個範圍內使用的值以下內容：

.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

像這樣：

Application.ScreenUpdating = False 
'On Error Resume Next 'Err.Numbers 9, 91 => Find: value not found 

Dim findCell as range 
ActiveWorkbook.Worksheets(shtSheet2).Select 
ActiveWorkbook.Worksheets(shtSheet2).UsedRange.Select 
'Color Uncommon records in Red Background 
For Each mycell In ActiveWorkbook.Worksheets(shtSheet1).UsedRange 
    Set findCell = Selection.Find(What:=Trim(mycell.value & ""), LookIn:=xlValues) 
    If findCell Is Nothing Then 

     mycell.Interior.Color = vbRed 
     mydiffs = mydiffs + 1 

    End If 
Next 

Note :
Please change Application.ScreenUpdating = True to Application.ScreenUpdating = False

如需更多信息，請使用this MSDN article

而對於使用你想要的功能：

Public Function look_up_id (r as Range) As Variant 
' 
'Function body 
' 
End Function 

'.... 
Call look_up_id(ActiveWorkbook.Worksheets(shtSheet2).Range("A:A", table)) 
'.... 

Answer 3

我會採取裂縫在這個

Sub compareSheets(shtSheet1 As String, shtSheet2 As String) 
Dim mycell As Range 
Dim mydiffs As Integer 
Dim ws1 as WorkSheet 
Dim ws2 as WorkSheet 
Dim rng as Range 
Dim SourceRow as integer 
Dim Col as integer 

set ws1 = ActiveWorkbook.Worksheets(shtSheet1) 
set ws2 = ActiveWorkbook.Worksheets(shtSheet2) 
myDiffs = 0 

'Application.ScreenUpdating = false 'enable this later, once it's all working 

'Color Uncommon records in Red Background 
'your key is in column A, so we'll only loop through that column 
For sourceRow = 1 to ws2.usedrange.Rows.Count 
    set rng = ws1.range(ws1.address).find(what:=ws2.cells(sourcerow, 1), LookIn:=xlValues, _ 
      LookAt=xlWhole, MatchCase:=False) 
      'making an assumption on MatchCase, change as needed 
    if not rng is Nothing then 'we found the key, now let's look at the rest of the row 
    col = 2 
    'loop through the rest of the columns for this row 
    while col < ws2.usedRange.Columns.Count 
     'if the cell in the row we just found on sheet1 <> the cell that we were looking for from sheet2 
     if rng.cells(1,col) <> ws2.cells(sourcerow,col) then 
     rng.cells(1,col).Interior.Color = vbRed 
     mydiffs = mydiffs+1 
     end if 
     col = col + 1 
    wend 
    else 
    'we didn't find the key. pop up a msgbox. you may want something else 
    MsgBox ("Sheet2 key: " & ws1.value & " not found on Sheet1") 
    end if 
'Display no. of differences 
MsgBox mydiffs & " differences found", vbInformation 
ActiveWorkbook.Sheets(shtSheet2).Select 
MsgBox "Data Scrubbed Successfully..." 
Application.ScreenUpdating = True 
End Sub