比较两个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