Excel VBA 类型不匹配 (13)

Excel VBA Type Mismatch (13)

提问by paradd0x

I am getting a type mismatch error in VBA and I am not sure why.

我在 VBA 中遇到类型不匹配错误，我不知道为什么。

The purpose of this macro is to go through a column in an Excel spreadsheet and add all the emails to an array. After each email is added to the first array, it's also supposed to added to a second array but split into two pieces at the @symbol in order to separate name from domain. Like so: [email protected]to personand gmail.com.

这个宏的目的是遍历 Excel 电子表格中的一列，并将所有电子邮件添加到一个数组中。在将每封电子邮件添加到第一个数组后，它也应该添加到第二个数组中，但在@符号处分成两部分，以便将名称与域分开。像这样：[email protected]到person和gmail.com。

The problem that I'm getting is that when it gets to the point where it's supposed to split the email, it throws a Type Mismatch error.

我遇到的问题是，当它达到应该拆分电子邮件的程度时，它会引发类型不匹配错误。

Specifically this part:

具体这部分：

strDomain = Split(strText, "@")

strDomain = Split(strText, "@")

Here is the complete code:

这是完整的代码：

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

回答by Brad

ReDiming arrays is a big hassle. Welcome to the world of collections and Dictionarys. Collectionobjects are always accessible. Dictionariesrequire a reference to Microsoft Scripting Runtime(Tools>References>scroll down to find that text and check the box> OK). They dynamically change size for you, you can add, remove items very easily compared to arrays, and Dictionaries especially allow you to organize your data in more logical ways.

ReDim数组是一个很大的麻烦。欢迎来到collections 和Dictionarys的世界。 集合对象始终是可访问的。字典需要参考Microsoft Scripting Runtime（工具>参考>向下滚动以找到该文本并选中该框>确定）。它们为您动态更改大小，与数组相比，您可以非常轻松地添加、删除项目，而字典尤其允许您以更合乎逻辑的方式组织数据。

In the below code I used a dictionary there the key is the domain (obtained with the split function). Each valuefor a keyis a collection of email addresses with that domain.

在下面的代码中，我使用了一个字典，其中的键是域（通过 split 函数获得）。每个valuefor akey是具有该域的电子邮件地址的集合。

Put a break point on End Suband look at the contents of each of these objects in your locals window. I think you'll see they make more sense and are easier in general.

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

Option Explicit

选项显式

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

and use it with

并使用它

Sub RemoveUnwantedEmails()

    Dim allemailsDic As Dictionary, doNotCallSheet As Worksheet, emailsSheet As Worksheet
    Set doNotCallSheet = Sheets("DoNotCallList")
    Set emailsSheet = Sheets("Sheet1")
    Set allemailsDic = AllEmails

    Dim domain As Variant, EmailAddress As Variant
    Dim foundDoNotCallDomains As Range, emailAddressesToRemove   As Range

    For Each domain In allemailsDic.Keys
        Set foundDoNotCallDomains = doNotCallSheet.Range("A:A").Find(domain)
        If Not foundDoNotCallDomains Is Nothing Then
            Debug.Print "domain found"
            'do your removal
            For Each EmailAddress In allemailsDic(domain)
                Set emailAddressesToRemove = emailsSheet.Range("E:E").Find(EmailAddress)
                If Not emailAddressesToRemove Is Nothing Then
                    emailAddressesToRemove = ""
                 End If
            Next EmailAddress
        End If
    Next domain

End Sub

回答by Jüri Ruut

strDomain must store array of the split text, therefore,

strDomain 必须存储拆分文本的数组，因此，

Dim strDomain As Variant

Afterwards, strDomain should be referenced by index, if operations with certain fragments will be made:

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

If strDomain(i) <> "" Then

回答by Aziz

The splitfunction returns an array of strings based on the provided separator.

的分裂函数返回基于所提供的分离器的字符串数组。

In your if you are sure that the original string is an email, with just one "@" in it then you can safely use the below code:

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

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

This will get you the part after "@" which is what you are looking for.

这将为您提供“@”之后的部分，这就是您要查找的内容。

回答by Majid Laissi

Splitreturns an array:

Split返回一个数组：

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

回答by Rory

Try strDomain = Split(strText,"@")(1)to get the right hand side of the split where (0)would be the left. And of course works with more than 2 splits as well. You could dim you string variable as an array strDomain()and then Split(strText,"@")will place all the seperated text into the array.

尝试strDomain = Split(strText,"@")(1)获得拆分的右侧，(0)而左侧将是该拆分的右侧。当然，也适用于 2 个以上的拆分。您可以将字符串变量作为数组变暗strDomain()，然后Split(strText,"@")将所有分隔的文本放入数组中。