Excel比较不同的工作表中的两个colums和不匹配的/不匹配的结果应该存储在其他工作表中

请张贴下面的VBA代码。

我需要比较不同工作表中的两列（例如：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

Answer 1

我会善良的，并假设你不知道从哪里开始。 我们有时build议人们尝试使用macroslogging器来获得他们所需的代码的第一个想法。 不幸的是，你的问题不是macroslogging器将会帮助你的问题。

比较两个这样的列表并不是最容易出现的第一个问题。 我曾经尝试在小步骤中进行翻译，以便能够理解它们。 麻烦的是有一些可能的情况，每一种情况都必须经过testing和行动：

• Sheet 1中的值而不是Sheet 2。 从Sheet1中获取新的值。
• Sheet 2中的值而不是Sheet 1。 logging不匹配。 从Sheet2获取新的价值。
• 值匹配。 从Sheet1和Sheet2获取新的值。
• Sheet1在Sheet2之前已经用完了值。 将Sheet2中的所有剩余值logging为不匹配。
• Sheet2已经用完了值。 完。

我已经解释了所有的步骤，但是我相信你一定要用F8来逐步减less代码。 如果你把鼠标hover在variables上，你可以看到它的值。

问你是否不明白，但先试试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 

新的部分，以回应改变原来的问题

我不明白你想要做什么，我假设你必须对我的原始代码进行更改。 下面我解释一些与你的要求相关的陈述。 你应该能够结合他们来创build你想要的例程。

问题1

你说列C现在是你想用来比较的列。 你也可以说行不是按照我的代码的升序排列的。 显而易见的解决scheme是按C列对工作表进行sorting。

我创build了以下代码：

• 开启macros录像机。
• select所有的Sheet1，说我有一个标题行，并按C列sorting
• closuresmacroslogging器。

使用macroslogging器是发现如何做的最简单的方法，但代码将需要一些调整。 macroslogging器保存的代码是：

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

我做了以下更改：

• 在此代码之前添加With Sheets("Sheet1")在此之后End With 。 保存的代码对活动工作表进行sorting。 我的更改说我想sortingSheet1无论哪个表是活动的。
• 通过删除合并两个语句。 .Select Selection 。 我不想select要sorting的范围，因为这会降低macros。
• 在Cells和Range之前放置一个点。 这将它们链接到With语句。
• 最后，我将Header:=xlGuessreplace为Header:=xlGuess by 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编辑器中select帮助并search“sorting方法”。 你会得到几个结果，其中一个将是“sorting方法”。 这将解释所有其他参数。 但是，你可能不需要。 如果您按照自己想要的方式对Sheet1进行sorting，则其他参数将根据您的需要进行sorting。

制作副本并将Sheet1replace为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列和Sheet2中的F列。现在你想在这两张表中使用C列。

用"C"replace"D"和"F"的所有引用。

问题3

您现在要从Sheet2复制17列到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

请在下面find简单的代码

 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