Excel比较不同工作表中的两个列，未比较/不匹配的结果应存储在其他工作表中

Question

请在下面发布 VBA 代码。

我需要比较不同工作表中的两列（例如：sheet1 中的 c 列和 sheet2 中的 c 列）。
Sheet1 和 sheet2 包含 17 列。我想要在 sheet3 中不匹配的项目（在 sheet2 中而不在 sheet1 中的项目）的结果。
Sheet3 应包含所有 17 列。
所有列都是文本格式。

D列F列 1 5 9 2 6 10 3 7 11 4 8 12 5 9 6 10 7 11 8 12 表 1 表 2 表 3

Answer 1

我会很友善，假设您不知道从哪里开始。我们有时建议人们尝试使用宏记录器来初步了解他们需要的代码。不幸的是，宏记录器无法解决您的问题。

比较像这样的两个列表并不是第一个问题最容易遇到的问题。我试图用小步骤做任何事情，这样你就可以理解它们。问题是有许多可能的情况，每种情况都必须进行测试并采取行动：

• Sheet1 中的值，但 Sheet2 中没有。从 Sheet1 中获取新值。
• Sheet2 中的值，但 Sheet1 中没有。记录不匹配。从 Sheet2 中获取新值。
• 值匹配。从 Sheet1 和 Sheet2 中获取新值。
• Sheet1 已用完 Sheet2 之前的值。将 Sheet2 中的所有剩余值记录为不匹配项。
• Sheet2 已用完值。完成。

我已经解释了所有的步骤，但我确信您需要使用 F8 来一次执行一个语句来降低代码。如果您将鼠标悬停在变量上，您可以看到它的值。

如果你不明白，请先尝试 F8。除非您告诉我您尝试了什么以及出了什么问题，否则我不会回答问题。

Option Explicit         ' This means I cannot use a variable I have not declared
Sub Compare()

  ' Declare all the variables I need
  Dim Row1Crnt As Long
  Dim Row2Crnt As Long
  Dim Row3Crnt As Long
  Dim Row1Last As Long
  Dim Row2Last As Long

  Dim ValueSheet1 As Long
  Dim ValueSheet2 As Long

  Dim NeedNewValueSheet1 As Boolean
  Dim NeedNewValueSheet2 As Boolean

  With Sheets("Sheet1")
    ' This goes to the bottom on column D, then go up until a value is found
    ' So this finds the last value in column D
    Row1Last = .Cells(Rows.Count, "D").End(xlUp).Row
  End With
  ' I assume Row 1 is for headings and the first data row is 2
  Row1Crnt = 2

  With Sheets("Sheet2")
    Row2Last = .Cells(Rows.Count, "F").End(xlUp).Row
  End With
  Row2Crnt = 2

  ' You do not say which column to use in Sheet 3 so I assume "H".
  ' You do not same in the column in Sheet 3 is empty so I place
  ' the values under any existing value
  With Sheets("Sheet3")
    Row3Crnt = .Cells(Rows.Count, "H").End(xlUp).Row
  End With
  Row3Crnt = Row3Crnt + 1   ' The first row under any existing values in column H

  ' In Sheet1, values are on rows Row1Crnt to Row1Last
  ' In Sheet2, values are on rows Row2Crnt to Row2Last
  ' In Sheet3, non-matching values are to be written to Row3Crnt and down

  ' In your questions, all the values are numeric and are in ascending order.
  ' This code assumes this is true for the real data.

    ' Load first values.  This will give an error if the values are not numeric.
    ' If the values are decimal, the decimal part will be lost.
    With Sheets("Sheet1")
      ValueSheet1 = .Cells(Row1Crnt, "D").Value
    End With
    With Sheets("Sheet2")
      ValueSheet2 = .Cells(Row2Crnt, "F").Value
    End With

  ' Loop for ever.  Code inside the loop must decide when to exit
  Do While True
    ' Test for each of the possible situations.
    If Row1Crnt > Row1Last Then
      ' There are no more values in Sheet1.  All remaining values in
      ' Sheet2 have no match
      With Sheets("Sheet3")
        .Cells(Row3Crnt, "H").Value = ValueSheet2
        Row3Crnt = Row3Crnt + 1
      End With
      'I need a new value from Sheet2
      NeedNewValueSheet2 = True
    ElseIf ValueSheet1 = ValueSheet2 Then
      ' The two values are the same.  Neither are required again.
      ' Record I need new values from both sheets.
      NeedNewValueSheet1 = True
      NeedNewValueSheet2 = True
    ElseIf ValueSheet1 < ValueSheet2 Then
      ' Have value in Sheet1 that is not in Sheet2.
      ' In the example in your question you do not record such values
      ' in Sheet3.  That is, you do not record 1, 2, 3 and 4 which are
      ' in Sheet1 but not Sheet3.  I have done the same.
      'I need a new value from Sheet1 but not Sheet2
      NeedNewValueSheet1 = True
      NeedNewValueSheet2 = False
    Else
      ' Have value in Sheet2 that is not in Sheet1.
      ' Record in Sheet3
      With Sheets("Sheet3")
        .Cells(Row3Crnt, "H").Value = ValueSheet2
        Row3Crnt = Row3Crnt + 1
      End With
      'I need a new value from Sheet2 but not Sheet1
      NeedNewValueSheet1 = False
      NeedNewValueSheet2 = True
    End If
    ' I have compared the two values and if a non match was found
    ' it has been recorded.

    ' Load new values as required
    If NeedNewValueSheet1 Then
      ' I need a new value from Sheet1
      Row1Crnt = Row1Crnt + 1
      If Row1Crnt > Row1Last Then
        ' There are no more in Sheet1. Any remaining values
        '  in Sheet2 are not matched.
      Else
        With Sheets("Sheet1")
         ValueSheet1 = .Cells(Row1Crnt, "D").Value
        End With
      End If
    End If

    If NeedNewValueSheet2 Then
      ' I need a new value from Sheet2
      Row2Crnt = Row2Crnt + 1
      If Row2Crnt > Row2Last Then
        ' There are no more in Sheet2.  Any remaining
        ' values in Sheet1 are ignored
        Exit Do
      End If
      With Sheets("Sheet2")
       ValueSheet2 = .Cells(Row2Crnt, "F").Value
      End With
    End If
  Loop

End Sub

新部分以响应对原始问题的更改

我不明白您要做什么，我认为您一定对我的原始代码进行了更改。下面我解释与您的要求相关的陈述。您应该能够将它们组合起来以创建您想要的例程。

问题 1

您说 C 列现在是您希望用于比较的列。您还说行不是我的代码假定的升序。显而易见的解决方案是按 C 列对工作表进行排序。

我通过以下方式创建了以下代码：

• 打开宏记录器。
• 选择所有 Sheet1，说我有一个标题行并按 C 列排序。
• 关闭宏记录器。

使用宏记录器是了解如何做某事的最简单方法，但代码需要进行一些调整。宏记录器保存的代码是：

  Cells.Select
  Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal

我做了以下更改：

• 在此代码前添加With Sheets("Sheet1")，在其后添加End With。保存的代码对活动工作表进行排序。我的更改表明我想对 Sheet1 排序，无论哪个工作表处于活动状态。
• 通过删除.Select Selection 合并两个语句。我不想选择要排序的范围，因为这会减慢宏的速度。
• 在Cells 和Range 之前放置一个点。这会将它们链接到 With 语句。
• 最后我将Header:=xlGuess 替换为Header:=xlYes。

结果是：

With Sheets("Sheet1")
  .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
End With

从 VBA 编辑器中选择帮助并搜索“排序方法”。你会得到几个结果，其中一个是“排序方法”。这将解释所有其他参数是什么。但是，您可能不需要这样做。如果您以您想要的方式对 Sheet1 进行了排序，则其他参数将根据您的需要进行。

制作一个副本并将 Sheet1 替换为 Sheet2 以给出：

With Sheets("Sheet1")
  .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
End With
With Sheets("Sheet2")
  .Cells.Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
End With

将这些新代码放在最后一个 Dim 语句之后。

问题 2

最初您想在 Sheet1 中使用 D 列，在 Sheet 2 中使用 F 列。现在您想在这两个工作表中使用 C 列。

将所有对"D" 和"F" 的引用替换为"C"。

问题 3

您现在想要将 17 列从 Sheet2 复制到 Sheet3。您没有说明要复制 Sheet2 中的哪些 17 列，或者 Sheet3 中的哪些 17 列将接收 17 列。在下面的代码中，我假设您要将列 A 到 Q 复制到以列 B 开头的 17 列。您应该会发现更改为所需的列很容易。

替换：

With Sheets("Sheet3")
  .Cells(Row3Crnt, "H").Value = ValueSheet2
  Row3Crnt = Row3Crnt + 1
End With   

通过

With Sheets("Sheet3")
  Worksheets("Sheet2").Range("A" & Row2Crnt & ":Q" & Row2Crnt).Copy _
                              Destination:=.Range("B" & Row3Crnt)
  Row3Crnt = Row3Crnt + 1
End With   

总结

我认为这些是您需要修改我的原始例程以获得所需例程的语句。

Answer 2

使用 ADO 和 Excel 可以做很多事情。它对于比较特别有用。

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''
''This is the ACE connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=No"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''In sheet2 but not in sheet1, all the SQL that can be used
''in ACE can be used here, JOINS, UNIONs and so on
strSQL = "SELECT a.F1,b.F1 FROM [Sheet2$] a " _
       & "LEFT JOIN [Sheet1$] b On a.F1=b.F1 " _
       & "WHERE b.F1 Is Null"

rs.Open strSQL, cn, 3, 3


''Pick a suitable empty worksheet for the results

Worksheets("Sheet3").Cells(1, 1).CopyFromRecordset rs

''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

Answer 3

请看下面的简单代码

Option Explicit
Sub Compare()

Dim Row1Crnt As Long
Dim Row2Crnt As Long
Dim Row3Crnt As Long    
Dim Row1Last As Long
Dim Row2Last As Long    

Dim ValueSheet1
Dim ValueSheet2
Dim duplicate As Boolean    
Dim maxColmn As Long
Dim i
maxColmn = 10  ' number of column to compare
For i = 1 To maxColmn

With Sheets("Sheet1")
    Row1Last = .Cells(Rows.Count, i).End(xlUp).Row
End With

With Sheets("Sheet2")
    Row2Last = .Cells(Rows.Count, i).End(xlUp).Row
End With

Row1Crnt = 2
Row2Crnt = 2
Row3Crnt = 2    
maxColmn = 10

Do While Row2Crnt <= Row2Last

duplicate = False
Row1Crnt = 2

With Sheets("Sheet2")
  ValueSheet2 = .Cells(Row2Crnt, i).Value
End With

Do While Row1Crnt <= Row1Last

 With Sheets("Sheet1")
  ValueSheet1 = .Cells(Row1Crnt, i).Value
End With

If ValueSheet1 = ValueSheet2 Then
 duplicate = True
 Exit Do

End If
Row1Crnt = Row1Crnt + 1
Loop

If duplicate = False Then
With Sheets("Sheet3")
    .Cells(Row3Crnt, i).Value = ValueSheet2
    Row3Crnt = Row3Crnt + 1
  End With

End If

Row2Crnt = Row2Crnt + 1
Loop
Next

End Sub