如果值已经存在，VBA宏不会将单元格复制到另一个工作表

Question

我有一个大约5000个联系人的列表，他们的信息是根据他们所做的工作组织的。如果一些人执行多种类型的工作，则会多次列出。如果联系人是根据他们所做的工作选择的，我会使用该列表向他们发送通知。

我使用电子邮件合并功能发送单独的电子邮件，因此我编写了一个宏，如果联系人的电子邮件已被选中，则将其复制到另一个工作表中。

Sub CopySelectedMasterToMerge()
Dim RangeToConsider2 As Range
Dim strAddresses2 As String
Dim shtSrc As Worksheet, shtDest As Worksheet
Set shtSrc = Sheets("MASTER")       'source sheet
Set shtDest = Sheets("Email Merge")  'destination sheet
destRow = 2                         'start copying to this row
Set RangeToConsider2 = Range("K4:K7000")
For Each Cell In RangeToConsider2
If Cell.Value = "a" Then
If Cell.Offset(0, 1) <> "ZZZZZZZZZ" Then
Cell.Offset(0, 6).Cells.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
End If
Next Cell
Worksheets("Email Merge").Activate
End Sub

除了拥有多个列表的联系人会收到同一封电子邮件的额外副本外，这与电子邮件合并一起非常有效。

如果另一个工作表中已经存在电子邮件，如何防止再次复制该电子邮件？

更新-根据@BigBen的建议，我让WorksheetFunction.CountIf开始工作。

For Each Cell In RangeToConsider2
If Cell.Value = "a" Then
EmailAddress = Cell.Offset(0, 6)
If Cell.Offset(0, 1) <> "ZZZZZZZZZ" Then
CountCheck = WorksheetFunction.CountIf(SearchArea, EmailAddress)
If CountCheck < 1 Then
Cell.Offset(0, 6).Cells.Copy shtDest.Cells(destRow, 1)
destRow = destRow + 1
End If
End If
End If
Next Cell

Answer 1

如果我理解正确，您是根据标准将电子邮件地址从一张表复制到另一张表，并且您希望得到的列表是唯一的吗？

您可以使用一个中间结构，如Collection或Dictionary来测试其唯一性。

Dictionary是一种键值结构，其中键必须是唯一的。该值可以与键相同。我更喜欢使用Dictionary，因为它有一个内置函数来测试键的存在。如果你使用了一个集合，你必须自己写：(

基本上，当你浏览电子邮件列表时，你会测试它们在字典中的存在，并只添加新条目。然后，您可以使用Dictionary内容来决定邮寄给谁——您甚至不需要将它们复制到新的工作表中。当然，如果你出于其他目的需要它们，你仍然可以。

这里有一个关于它们是什么以及如何使用它们的优秀教程。