附加条件只复制新值

下面的代码可以很好地识别表（SOC 5）中列BH中具有特定值的数据行，并将行A列中的相应值从各行分别复制到新表中。 但是，我需要修改代码，以复制到我的目的地工作表只有新识别的值。 意思是，目标表已经有一些我正在寻找的价值。 刷新我的底层数据后，我需要代码才能获取符合条件的最新值。

Sub Cond5Copy() 'The data is in sheet Data Sheets("Data").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row For i = 1 To RowCount 'the qualifying value is in column BH Range("BH" & i).Select check_value = ActiveCell If check_value = "5" Then Cells(Application.ActiveCell.Row, 1).Copy 'The destination set is in sheet SOC 5 Sheets("SOC 5").Select RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row Range("a" & RowCount + 1).Select ActiveSheet.Paste Sheets("Data").Select End If Next End Sub 

Answer 1

您可以尝试移动符合以下条件的所有数据：

 Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long Set s = Sheets("Data") 's for Source Set d = Sheets("SOC 5") 'd for Destination LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source For i = 1 to LRs If s.Cells( i, "BH") = 5 Then LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination s.Rows(i).Copy d.Rows(LRd + 1) End If Next i 

---

你可以用它来validation最新的数据：

 Dim s as Worksheet, d as Worksheet, LRs as Long, LRd as Long Set s = Sheets("Data") 's for Source Set d = Sheets("SOC 5") 'd for Destination LRs = s.Cells( s.Rows.Count, "A").End(xlUp).Row 'last row of source LRd = d.Cells( d.Rows.Count, "A").End(xlUp).Row 'last row of destination For i = 1 to LRd If d.Cells( i, "B") = Application.Index( s.Range( s.Cells(1, "B"), s.Cells(LRs, "B")), Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)) Then s.Rows(Application.Match(d.Cells( i, "A"), s.Range( s.Cells(1, "A"), s.Cells(LRs, "A")),0)).Copy d.Rows(i) End If Next i 

在A中使用abritrary查找匹配（匹配）和B（索引）的输出。

Answer 2

所以这听起来像你想要一个独特的值列表。 你有没有考虑过使用字典对象？ Excel VBA中的字典对象有一个方法来允许您检查字典中是否存在一个值。 这使您能够通过检查您正在考虑添加到字典中的值在字典中是否已经存在，从而仅使用唯一值来轻松填充字典。

如果这听起来很有希望，那么我鼓励您访问以下资源，以了解有关如何在VBA中使用字典的更多信息：

https://excelmacromastery.com/vba-dictionary/#A_Quick_Guide_to_the_VBA_Dictionary

你会想要使用以下存在的方法：

 dict.Exists(Key) 

检查一个值是否已经在字典中。

请让我知道，如果这个答案不够清楚，因为我可以阐述，如果有必要。

Answer 3

 Sub Cond5CopyNew() Dim wsSource As Worksheet Dim wsDest As Worksheet Dim rowCount As Long Set wsSource = Worksheets("Data") Set wsDest = Worksheets("SOC 5") Application.ScreenUpdating = False With wsSource rowCount = .Cells(.Cells.Rows.Count, "a").End(xlUp).Row For i = 1 To rowCount If .Cells(i, "BH").Value = 5 Then 'Second check, make sure it's not already copied If WorksheetFunction.CountIf(wsDest.Range("A:A"), .Cells(i, "A").Value) = 0 Then 'Copy the row over to next blank row .Cells(i, "A").Copy wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1) End If End If Next i End With Application.ScreenUpdating = True End Sub