4

VBAでタイプの不一致エラーが発生しましたが、その理由がわかりません。

このマクロの目的は、Excelスプレッドシートの列を調べて、すべての電子メールを配列に追加することです。@各電子メールが最初の配列に追加された後、それは2番目の配列にも追加されることになっていますが、ドメインから名前を分離するために、シンボルで2つの部分に分割されます。そのように：person@gmail.comtopersonと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

ReDimアレイを作成するのは非常に面倒です。collectionsとsの世界へようこそDictionary。 コレクションオブジェクトにはいつでもアクセスできます。辞書には、への参照が必要ですMicrosoft Scripting Runtime（[ツール]>[参照]>下にスクロールしてそのテキストを見つけ、[OK]チェックボックスをオンにします）。それらは動的にサイズを変更し、配列と比較して非常に簡単にアイテムを追加および削除できます。特に辞書を使用すると、より論理的な方法でデータを整理できます。

以下のコードでは、辞書を使用しました。キーはドメインです（分割関数で取得）。それぞれvalueのakeyは、そのドメインの電子メールアドレスのコレクションです。

ブレークポイントを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

と一緒に使用します

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関数は、指定されたセパレータに基づいて文字列の配列を返します。

元の文字列が電子メールであり、「@」が1つだけ含まれていることが確実な場合は、次のコードを安全に使用できます。

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

これにより、探している「@」の後の部分が表示されます。

于 2012-11-08T20:31:27.843 に答える
1

strDomain = Split(strText,"@")(1)スプリットの右側を左側にするようにしてください(0)。そしてもちろん、2つ以上のスプリットでも機能します。文字列変数を配列として暗くしてから、すべての分離されたテキストを配列に配置することができstrDomain()ますSplit(strText,"@")。

于 2012-11-08T20:15:08.163 に答える
1

Split配列を返します：

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