4

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

此宏的目的是遍历 Excel 电子表格中的列并将所有电子邮件添加到数组中。将每封电子邮件添加到第一个数组后，还应该将其添加到第二个数组，但在@符号处分成两部分，以便将名称与域分开。像这样：person@gmail.com到person和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
4

5 回答 5

5

ReDiming arrays is a big hassle. Welcome to the world of collections and Dictionarys. Collection objects are always accessible. Dictionaries require 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.

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

Put a break point on End Sub and 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.

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
于 2012-11-08T20:07:39.450 回答
4

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

Dim strDomain As Variant

之后，strDomain 应该被索引引用，如果将进行某些片段的操作：

If strDomain(i) <> "" Then
于 2012-11-08T20:17:35.513 回答
2

split函数根据提供的分隔符返回一个字符串数组。

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

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

这将为您提供您正在寻找的“@”之后的部分。

于 2012-11-08T20:31:27.843 回答
1

Split返回一个数组：

Dim mailComp() As String
[...]
mailComp = Split(strText, "@")
strDomain = mailComp(1)
于 2012-11-08T20:13:26.853 回答
1

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.

于 2012-11-08T20:15:08.163 回答