Excel VBA宏,如果值已存在,则不将单元格复制到另一张图纸
我有一份约5000名联系人的名单,其中包含他们所从事工作的信息。如果执行多种类型的工作,则会多次列出一些。我使用该列表向联系人发送通知,如果他们是根据他们执行的工作选择的 我使用电子邮件合并功能发送单独的电子邮件,因此我编写了一个宏,将联系人的电子邮件复制到另一个工作表(如果已选中)Excel VBA宏,如果值已存在,则不将单元格复制到另一张图纸,excel,vba,Excel,Vba,我有一份约5000名联系人的名单,其中包含他们所从事工作的信息。如果执行多种类型的工作,则会多次列出一些。我使用该列表向联系人发送通知,如果他们是根据他们执行的工作选择的 我使用电子邮件合并功能发送单独的电子邮件,因此我编写了一个宏,将联系人的电子邮件复制到另一个工作表(如果已选中) Sub CopySelectedMasterToMerge() Dim RangeToConsider2 As Range Dim strAddresses2 As String Dim shtSrc As Wo
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
如果我理解正确,您正在根据标准将电子邮件地址从一张工作表复制到另一张工作表,并且您希望生成的列表是唯一的 您可以使用集合或字典等中间结构来测试唯一性 字典是一种键值结构,其中键必须是唯一的。该值可以与键相同。我更喜欢使用字典,因为它有一个内置函数来测试键的存在。如果使用集合,则必须编写自己的:) 基本上,当你浏览电子邮件列表时,你会在字典中测试它们是否存在,并且只添加新条目。然后,您可以使用字典内容来决定向谁发送邮件-您甚至不需要将它们复制到新的工作表中。当然,如果你出于其他目的需要它们,你仍然可以
这是一篇关于它们是什么以及如何使用它们的优秀文章。可能使用
工作表函数。CountIf
,或应用程序。Match
,或范围。查找。只是一条与您的问题无关的一般性评论-使用范围将其限制在范围所在的工作表中是一个很好的做法,否则,如果活动图纸发生更改,您可能会得到意外的结果。在本例中,它将被设置为RangeToConsider2=shtSrc.Range(“K4:K7000”)。谢谢您。是的,这是一个我没有想到的好主意。谢谢你@BigBen!我能利用你的建议使它发挥作用。是的,在你的第一段。我不熟悉字典,所以谢谢你的指导和建议。我会看一看,看能不能弄明白/看能不能用。据我所知,与Microsoft的电子邮件合并需要在单独的工作表上有一个单独的列表才能正常工作。至少我是这么用的。能够快速记录、搜索和回顾名单上的人也很好。我认为这不会奏效,因为内存有限。有一个很好的变化,字典需要存储5000多个条目才能工作。对于其他功能,我发现我的个人电脑限制在1000台左右,同时我还运行内存大的其他程序。很公平,很高兴你让它正常工作。
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