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

Excel compare Two colums in different sheets and uncompared/unmatched result should be stored in other worsheet

提问by neobee

Please post VBA code for below.

请在下面发布VBA代码。

I need to compare two columns in different worksheets (e.g.: column c in sheet1 and Column c in sheet2).
Sheet1 and sheet2 contains 17 columns. and I want result of unmatched items( items which arein sheet2 and not in sheet1) in sheet3.
Sheet3 should containn all 17 columns.
all columns are in text format.

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

columnD columnF 
1       5       9
2       6       10
3       7       11
4       8       12
5       9
6       10
7       11
8       12
sheet1  sheet2  sheet3

回答by Tony Dallimore

I will be kind and assume you do not know where to start. We sometimes suggest people try using the macro recorder to get a first idea of the code they need. Unfortunately, you problem is not one for which the macro recorder will help.

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

Comparing two lists like this is not the easiest problem to have as a first problem. I have tried to do everthing in little steps so you can understand them. The trouble is there are a number of possible situations each of which must be tested for and actioned:

像这样比较两个列表并不是第一个问题最简单的问题。我试图用小步骤完成所有事情，以便您可以理解它们。问题是有多种可能的情况，每种情况都必须进行测试并采取行动：

• Value in Sheet1 but not Sheet2. Get new value from Sheet1.
• Value in Sheet2 but not Sheet1. Record non-match. Get new value from Sheet2.
• Values match. Get new values from both Sheet1 and Sheet2.
• Sheet1 has run out values before Sheet2. Record all remaining values in Sheet2 as non matches.
• Sheet2 has run out values. Finish.

• Sheet1 中的值，而不是 Sheet2 中的值。从 Sheet1 获取新值。
• Sheet2 中的值，而不是 Sheet1 中的值。记录不匹配。从 Sheet2 获取新值。
• 价值观一致。从 Sheet1 和 Sheet2 获取新值。
• Sheet1 在 Sheet2 之前已经用完了值。将 Sheet2 中的所有剩余值记录为不匹配。
• Sheet2 已用完值。结束。

I have explained all the steps but I am sure you will need to use F8 to step down the code one statement at a time. If you hover over a variable you can see its value.

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

Ask if you do not understand but try F8 first. I will not answer questions unless you tell me what you have tried and what went wrong.

不懂就问，先试试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

New section in response to change to original question

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

I do not understand what you are trying to do and I assume you must have made changes to my original code. Below I explain statements that appear relevant to your requirement. You should be able to combine them to create the routine you want.

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

Issue 1

第 1 期

You say column C is now the column you wish to use for comparisons. You also say that rows are not in ascending sequence which my code assumes. The obvious solution is to sort the worksheets by column C.

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

I created the following code by:

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

• Switching the macro recorder on.
• Selecting all of Sheet1, saying I had a header row and sorting it by column C.
• Switching the macro recorder off.

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

Using the macro recorder is the easiest way of discovering how to do something but the code will need some adjustment. The code saved by the macro recorder is:

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

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

I make the following changes:

我进行了以下更改：

• Add With Sheets("Sheet1")before this code and End Withafter it. The saved code sorts the active sheet. My changes say I want to sort Sheet1 whichever sheet is active.
• Merge the two statements by deleting .Select Selection. I do not want to select the range to be sorted because this slows the macro.
• Place a dot before the Cellsand the Range. This links them to the With Statement.
• Finally I replace Header:=xlGuessby Header:=xlYes.

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

The result is:

结果是：

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

Select Help from the VBA Editor and search for "sort method". You will get several results of which one will be "Sort Method". This will explain what all the other parameters are. However, you probably do not need to. If you have sorted Sheet1 the way you want, the other parameters will be as you need.

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

Make a copy and replace Sheet1 with Sheet2 to give:

复制一份并用 Sheet2 替换 Sheet1 以给出：

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

Place these new code just after the last of the Dim statments.

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

Issue 2

第二期

Originally you wanted to use column D in Sheet1 and column F in Sheet 2. Now you want to use column C in both these sheets.

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

Replace all references to "D"and "F"by "C".

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

Issue 3

第 3 期

You now want to copy 17 columns from Sheet2 to Sheet3. You do not say which 17 columns in Sheet2 you want to copy or which 17 columns in Sheet3 are to receive the 17 columns. In the following code I assume you want to copy columns A to Q to the 17 columns starting with columns B. You should find it easy to change to the columns you require.

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

Replace:

代替：

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

by

经过

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

Summary

概括

I think these are the statements you need to modify my original routine to get the routine you require.

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

回答by Fionnuala

It is possible to do a lot with ADO and Excel. it is particularly useful for comparisions.

使用 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

回答by Sandip Jadhav

Please find below simple code

请找到下面的简单代码

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