请在下面发布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
答案 0 :(得分：3)
我会很善良，并假设你不知道从哪里开始。我们有时建议人们尝试使用宏录制器来首先了解他们需要的代码。不幸的是，你的问题不是宏记录器会帮助的问题。
比较这样的两个列表并不是第一个问题最简单的问题。我试图在很短的步骤内完成，以便你能理解它们。麻烦的是，有许多可能的情况，每个情况都必须进行测试和采取行动：
我已经解释了所有步骤，但我确信您需要使用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列对工作表进行排序。
我通过以下方式创建了以下代码：
使用宏录制器是发现如何做某事的最简单方法，但代码需要进行一些调整。宏录制器保存的代码为：
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 Statement。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编辑器中选择“帮助”，然后搜索＆＃34;排序方法＆＃34;。您将得到几个结果，其中一个将是＆＃34;排序方法＆＃34;。这将解释所有其他参数是什么。但是，您可能不需要。如果您按照自己的方式对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期
您现在想要将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
<强>摘要
我认为这些是您修改原始例程以获得所需例程所需的语句。
答案 1 :(得分：0)
使用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
答案 2 :(得分：0)
请在下面找到简单的代码
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