Excel VBA類型不匹配（13）

Question

我得到了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 

Answer 1

ReDim荷蘭國際集團陣列是一個很大的麻煩。歡迎來到世界collection s和Dictionary s。 Collection對象始終可以訪問。 Dictionaries需要參考Microsoft Scripting Runtime（工具>參考>向下滾動以找到該文本並勾選框>確定）。它們可以動態地改變大小，與數組相比，您可以非常輕鬆地添加，刪除項目，並且字典特別允許您以更合理的方式組織數據。

在下面的代碼中，我使用了一個字典那裏的關鍵是域（用分裂函數獲得）。 key的每個value是具有該域的電子郵件地址的集合。

在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 

Answer 2

Split使用它返回一個數組：

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

Answer 3

嘗試strDomain = Split(strText,"@")(1)拿到拆分的右手一側(0)會是左邊。當然也可以使用兩個以上的分割。您可以將字符串變量調暗爲數組strDomain()，然後Split(strText,"@")將所有分離的文本放入數組中。

Answer 4

strDomain必須存儲拆分文本的陣列，因此，

Dim strDomain As Variant 

然後，strDomain應由索引來引用，如果與特定片段的操作將做出：

If strDomain(i) <> "" Then 

Answer 5

的分裂函數根據提供的分隔符返回一個字符串數組。

在你的，如果你是確保原始字符串的郵件，只用一個「@」的，那麼你可以安全地使用下面的代碼：

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

這將讓你之後的部分「 @「這是你正在尋找的。