簡體   English   中英

如果值已經存在,VBA 宏不會將單元格復制到另一個工作表

[英]VBA Macro to not Copy Cell over to Another Sheet if Value Already Exists

我有一個大約 5000 個聯系人的列表,他們的信息按他們執行的工作組織。 如果他們執行多種類型的工作,一些會被多次列出。 如果根據他們執行的工作選擇了聯系人,我會使用該列表向聯系人發送通知。

我使用 Email 合並 function 來發送單個電子郵件,因此我編寫了一個宏來將聯系人的 email 復制到另一個工作表(如果它們已被選中)。

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

這與 Email 合並一起工作得非常好,除了具有多個列表的聯系人正在接收相同 email 的額外副本。

如果 email 已經存在於另一個工作表上,如何防止它被再次復制?

更新- 使用@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

如果我對您的理解正確,您正在根據標准將 email 地址從一張紙復制到另一張紙,並且您希望結果列表是唯一的?

您可以使用像 Collection 或 Dictionary 這樣的中間結構來測試唯一性。

字典是鍵值結構,其中鍵必須是唯一的。 該值可以與鍵相同。 我更喜歡使用字典,因為它有一個內置的 function 來測試密鑰的存在。 如果您使用 Collection,則必須自己編寫:)

基本上,當您瀏覽電子郵件列表時,您會測試它們在字典中是否存在,並且只添加新條目。 然后,您可以使用 Dictionary 內容來決定要郵寄給誰 - 您甚至不需要將它們復制到新工作表中。 當然,如果您出於其他目的需要它們,您仍然可以。

這是一個關於它們是什么以及如何使用它們的優秀教程

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM