Excel VBA类型不匹配（13）

我在VBA中遇到类型不匹配错误，我不确定原因

此宏的目的是遍历Excel电子表格中的一列，并将所有电子邮件添加到一个数组中。在将每封电子邮件添加到第一个数组后，它也应该添加到第二个数组中，但在

@

符号处分成两部分，以便将名称与域分开。像这样：

person@gmail.com

到

个人

和

gmail.com

我遇到的问题是，当它到达应该拆分电子邮件的位置时，会抛出一个类型不匹配错误

具体而言，本部分：

strDomain=Split（strText，“@”）

以下是完整的代码：

Sub addContactListEmails()
    Dim strEmailList() As String    'Array of emails
    Dim blDimensioned As Boolean    'Is the array dimensioned?
    Dim strText As String           'To temporarily hold names
    Dim lngPosition As Long         'Counting

    Dim strDomainList() As String
    Dim strDomain As String
    Dim dlDimensioned As Boolean
    Dim strEmailDomain As String
    Dim i As Integer

    Dim countRows As Long
    'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
    countRows = Range("E:E").CurrentRegion.Rows.Count
    MsgBox "The number of rows is " & countRows

    'The array has not yet been dimensioned:
    blDimensioned = False

    Dim counter As Long
    Do While counter < countRows
        counter = counter + 1

        ' Set the string to the content of the cell
        strText = Cells(counter, 5).Value

        If strText <> "" Then

            'Has the array been dimensioned?
            If blDimensioned = True Then

                'Yes, so extend the array one element large than its current upper bound.
                'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing
                ReDim Preserve strEmailList(0 To UBound(strEmailList) + 1) As String

            Else

                'No, so dimension it and flag it as dimensioned.
                ReDim strEmailList(0 To 0) As String
                blDimensioned = True

            End If

            'Add the email to the last element in the array.
            strEmailList(UBound(strEmailList)) = strText

            'Also add the email to the separation array
            strDomain = Split(strText, "@")
            If strDomain <> "" Then
                    If dlDimensioned = True Then
                        ReDim Preserve strDomainList(0 To UBound(strDomainList) + 1) As String
                    Else
                        ReDim strDomainList(0 To 0) As String
                        dlDimensioned = True
                    End If
                strDomainList(UBound(strDomainList)) = strDomain
            End If

        End If

    Loop


    'Display email addresses, TESTING ONLY!

    For lngPosition = LBound(strEmailList) To UBound(strEmailList)

        MsgBox strEmailList(lngPosition)

    Next lngPosition

    For i = LBound(strDomainList) To UBound(strDomainList)

        MsgBox strDomainList(strDomain)

    Next

    'Erase array
    'Erase strEmailList

End Sub

Sub addContactListMail（）
Dim strEmailList（）作为电子邮件的字符串数组
Dim blDimensioned As Boolean'数组是否已标注尺寸？
将strText设置为字符串“以临时保存名称
与“长”计数一样暗的位置
Dim strDomainList（）作为字符串
作为字符串的Dim strDomain
标注为布尔值的尺寸标注
将域设置为字符串
作为整数的Dim i
数行一样长
'countRows=列（“E:E”）.SpecialCells（xlVisible）.Rows.Count
countRows=范围（“E:E”）.CurrentRegion.Rows.Count
MsgBox“行数为”&countRows
'阵列尚未确定尺寸：
blDimensioned=False
昏暗的柜台一样长
当计数器

ReDim

ing阵列是一个大麻烦。欢迎来到

collection

s和

Dictionary

s的世界。对象总是可以访问的。需要对Microsoft脚本运行时的引用（工具>引用>向下滚动以查找该文本并选中框>确定）。它们可以动态地为您更改大小，与数组相比，您可以非常轻松地添加、删除项，字典尤其允许您以更符合逻辑的方式组织数据

在下面的代码中，我使用了一个字典，其中的键是域（通过split函数获得）。

键的每个
值
都是该域的电子邮件地址集合

在
End Sub
上放置一个断点，并在本地窗口中查看每个对象的内容。我想你会发现它们更有意义，而且总体上更简单

选项显式

Function AllEmails() As Dictionary

    Dim emailListCollection As Collection
    Set emailListCollection = New Collection 'you're going to like collections way better than arrays
    Dim DomainEmailDictionary As Dictionary
    Set DomainEmailDictionary = New Dictionary 'key value pairing. key is the domain. value is a collection of emails in that domain
    Dim emailParts() As String
    Dim countRows As Long
    Dim EmailAddress As String
    Dim strDomain As String

    'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count
    Dim sht As Worksheet 'always declare your sheets!
    Set sht = Sheets("Sheet1")

    countRows = sht.Range("E2").End(xlDown).Row

    Dim counter As Long
    Do While counter < countRows
        counter = counter + 1

        EmailAddress = Trim(sht.Cells(counter, 5))

        If EmailAddress <> "" Then

            emailParts = Split(EmailAddress, "@")
            If UBound(emailParts) > 0 Then
                strDomain = emailParts(1)
            End If

            If Not DomainEmailDictionary.Exists(strDomain) Then
                'if you have not already encountered this domain
                DomainEmailDictionary.Add strDomain, New Collection
            End If

            'Add the email to the dictionary of emails organized by domain
            DomainEmailDictionary(strDomain).Add EmailAddress

            'Add the email to the collection of only addresses
            emailListCollection.Add EmailAddress
        End If
    Loop

    Set AllEmails = DomainEmailDictionary
End Function

Split
返回一个数组：

Dim mailComp() As String
[...]
mailComp = Split(strText, "@")
strDomain = mailComp(1)

尝试
strDomain=Split（strText，“@”）（1）
以获取拆分的右侧，其中
（0）
将位于左侧。当然，也可以使用2次以上的拆分。您可以将字符串变量设置为数组
strDomain（）
，然后
Split（strText，“@”）
将把所有分离的文本放入数组。
strDomain必须存储分割文本的数组，因此

Dim strDomain As Variant

之后，如果要对某些片段进行操作，则应通过索引引用strDomain：

If strDomain(i) <> "" Then

如果strDomain（i）“，则
split函数根据提供的分隔符返回字符串数组

在您的电子邮件中，如果您确定原始字符串是电子邮件，其中只有一个“@”，则可以安全地使用以下代码：

strDomain = Split(strText, "@")(1)

这将得到您要查找的“@”之后的部分。
编译错误，在
如果是strDomain“”，则键入不匹配的
，然后
是的，这里有很多问题。我会在一分钟内得到一个更全面的答案。收藏可以更容易地与另一张表进行比较，并返回匹配项？这是一个非常开放的问题，有很多事情要做。集合与数组一样，与
工作表
或将事物匹配在一起无关。集合是可以用来完成该任务的工具（范围也是如此）。这取决于你要带着这个去哪里。一般来说，我会说是/不使用数组，而是使用范围本身。我的目标是从Sheet1（联系人列表）中的每封电子邮件中获取域，并与Sheet2（不联系表单）中的域列表进行比较。因此，如果在10封电子邮件中，Sheet1中的2个域与Sheet2中的一个域匹配，则它们将从Sheet1中删除。完成比较的最简单方法是什么？
strDomain = Split(strText, "@")(1)