Excel VBA -查找不匹配行并将其复制到另一个工作表。
Excel VBA -查找不匹配行并将其复制到另一个工作表。
提问于 2021-08-21 16:13:33
我想比较同一工作表中的2列，当与D列相比时，搜索A列中的非匹配值，并将A列中这些非匹配值的整行复制到另一个工作表。
下面是工作表的示例：
因此，我想将A列与D列进行比较，找出不匹配的值，并将整个对应行从A和B复制到新的工作表中。
*编辑，我忘了包括我的代码
Dim CopyToRow As Integer
Dim rng1 As Range
Dim rng2 As Range
Dim cell As Range
Dim found As Range
'Start copying data to row 2 in Sheet2 (row counter variable)
CopyToRow = 2
Set rng1 = Range(ActiveSheet.Cells(2, 1), ActiveSheet.Cells(2, 1).End(xlDown))
Set rng2 = Range(ActiveSheet.Cells(4, 2), ActiveSheet.Cells(4, 2).End(xlDown))
For Each cell In rng1
Set found = rng2.Find(what:=cell, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not found Is Nothing Then
cell.EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & CopyToRow)
CopyToRow = CopyToRow + 1
End If
Next cell非常感谢和感谢！
Stack Overflow用户
回答已采纳
发布于 2021-08-21 20:43:30
我同意罗恩·罗森菲尔德的观点，你应该展示你自己的尝试。话虽如此，也许这会对你有所帮助。不是最优雅的，但应该工作，只要您更新对您自己的工作表名称的引用。
Sub SOPractice()
Dim SearchCell As Range 'each value being checked
Dim SearchRng As Range 'column A
Dim LastRow As Long
Dim MatchFound As Range
Dim i As Long: i = 1
LastRow = YourSheet.Range("A" & Rows.Count).End(xlUp).Row
With YourSheet
Set SearchRng = .Range(.Cells(2, 1), .Cells(LastRow, 1))
Application.ScreenUpdating = False
For Each SearchCell In SearchRng
Set MatchFound = .Range("D:D").Find _
(What:=SearchCell.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If MatchFound Is Nothing Then 'No match hence copy to other sheet
.Range(SearchCell.Address, SearchCell.Offset(, 1)).Copy
YourCopyToSheet.Cells(i, 1).PasteSpecial xlPasteAll
i = i + 1
End If
Next SearchCell
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/68874726
复制相关文章
相似问题
腾讯云开发者
