VBA 比较两列中的值,并将缺失值行复制到新工作表
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/23928051/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA to compare values in two columns, and copy the row of missing values to a new worksheet
提问by user3686307
I'm new to this, so really don't know where to start.
我是新手,所以真的不知道从哪里开始。
here is my best description the macro i'd like to achieve:
这是我对我想要实现的宏的最佳描述:
Compare all values in column "B" of worksheet "E Dump" to values in column "G" in worksheet "F Dump".
将工作表“E Dump”的“B”列中的所有值与工作表“F Dump”中的“G”列中的值进行比较。
Any value that appears in column "B", but not column "E" copy that entire row from worksheet "E Dump" into the next available row on worksheet "Mismatch".
出现在“B”列而非“E”列中的任何值都将整行从工作表“E Dump”复制到工作表“不匹配”上的下一个可用行。
Any help much apreciated!
非常感谢任何帮助!
回答by D Mason
Below is some working code i have just written. This could also be done using search functions but regardless this should work. My only other comment is that if you post your own attempts you are allot more likely to get a response!
下面是我刚刚编写的一些工作代码。这也可以使用搜索功能来完成,但无论如何这应该有效。我唯一的其他评论是,如果您发布自己的尝试,则更有可能获得回复!
Sub compareAndCopy()
Dim lastRowE As Integer
Dim lastRowF As Integer
Dim lastRowM As Integer
Dim foundTrue As Boolean
' stop screen from updating to speed things up
Application.ScreenUpdating = False
lastRowE = Sheets("E Dump").Cells(Sheets("E Dump").Rows.Count, "B").End(xlUp).row
lastRowF = Sheets("F Dump").Cells(Sheets("F Dump").Rows.Count, "G").End(xlUp).row
lastRowM = Sheets("Mismatch").Cells(Sheets("Mismatch").Rows.Count, "B").End(xlUp).row
For i = 1 To lastRowE
foundTrue = False
For j = 1 To lastRowF
If Sheets("E Dump").Cells(i, 2).value = Sheets("F Dump").Cells(j, 7).value Then
foundTrue = True
Exit For
End If
Next j
If Not foundTrue Then
'MsgBox ("didnt find string: " & Sheets("E Dump").Cells(i, 2).value)
Sheets("E Dump").Rows(i).Copy Destination:= _
Sheets("Mismatch").Rows(lastRowM + 1)
lastRowM = lastRowM + 1
End If
Next i
' stop screen from updating to speed things up
Application.ScreenUpdating = True
End Sub