在VBA中区分不同的字符串和填充字符串?

Gre*_*ory 2 excel vba

我有两个字符串,我需要区分.它们前后都有文本,我似乎无法弄清楚如何找到每个字符串并解析其相关信息.

Dim cell As Range
Dim toPrimary As String
Dim toCC As String  

For Each cell In Range("A2:A350")
    If cell.Value Like "*.USA.*" Then 'This is the first one
        toCC = toCC & ";" & "USA@email.com"
    ElseIf cell.Value Like "*.Burrito.*" Then
        toCC = toCC & ";" & "Durr@ito.com"
    ElseIf cell.Value Like "*.USA.Taco.*" Then 'This is the second
        toCC = toCC & ";" & "taco@bell.com"
    End If
Next
Run Code Online (Sandbox Code Playgroud)

我期待着.USA..USA.Taco.将使用不同的信息填充toCC字段.如果它有任何区别,.USA.之后只有三个字符(即.USA.Pie.),而.USA.Taco.在'USA'之后有相同的字符串'Taco'.

Mat*_*don 5

这是问题所在:

If cell.Value Like "*.USA.*" Then 'This is the first one
    '...
'...
    '...
ElseIf cell.Value Like "*.USA.Taco.*" Then 'This is the second
    '...
End If
Run Code Online (Sandbox Code Playgroud)

如果cell.Value匹配*.USA.Taco.*,那么它匹配*.USA.*,并给出你如何排序条件,如果有任何匹配,*.USA.*那么它匹配的其他什么并不重要,因为其他一切都在一个ElseIf块中.

翻转它们:检查是否cell.Value匹配*.USA.Taco.* 之前验证匹配*.USA.*:

If cell.Value Like "*.USA.Taco.*" Then
    '...
ElseIf cell.Value Like "*.USA.*" Then
    '...
ElseIf cell.Value Like "*.Burrito.*" Then
    '...
End If
Run Code Online (Sandbox Code Playgroud)

您只想列出每个收件人一次 - 没有人希望收到相同电子邮件的300倍(假设他们的邮件服务器不仅阻止发件人).

不要像这样构建字符串,而是创建一个键控集合:

Dim ccRecipients As Collection
Set ccRecipients = New Collection

If cell.Value Like ...
    ccRecipients.Add "USA@email.com", Key:="USA@email.com"
ElseIf cell.Value Like ...
    ccRecipients.Add "Durr@ito.com", Key:="Durr@ito.com"
...
Run Code Online (Sandbox Code Playgroud)

将重复地址添加到集合时,这将引发错误.因此,制定一个专门的程序来安全地完成它:

Private Sub AddUniqueItemToCollection(ByVal value As String, ByVal items As Collection)
    On Error Resume Next
    items.Add value, key:=value
    On Error GoTo 0
End Sub
Run Code Online (Sandbox Code Playgroud)

然后调用它:

Dim ccRecipients As Collection
Set ccRecipients = New Collection

If cell.Value Like ...
    AddUniqueItemToCollection "USA@email.com", ccRecipients
ElseIf cell.Value Like ...
    AddUniqueItemToCollection "Durr@ito.com", ccRecipients
...
Run Code Online (Sandbox Code Playgroud)

然后,您可以迭代集合中的唯一项,将它们添加到数组中:

ReDim ccAddresses(0 To ccRecipients.Count - 1)

Dim ccAddress As Variant, ccItem As Long
For Each ccAddress In ccRecipients
    ccAddresses(ccItem) = CStr(ccAddress)
    ccItem = ccItem + 1
Next
Run Code Online (Sandbox Code Playgroud)

现在,您可以使用Join构建最终的收件人列表,并用分号分隔每个收件人:

Dim sendToCC As String
sendToCC = Join(ccAddresses, ";")
Run Code Online (Sandbox Code Playgroud)

这样你就不会发送垃圾邮件给任何人的收件箱了!