VBA：重新调整多个按键集合=错误9'下标超出范围'？

我试图修改一些键控的集合代码（谢谢@Mat'sMug！），使它通过3个不同的范围循环，然后将值放入各自的variables。 第一个键控集合工作正常，但第二个（我猜是第三个一旦超过第二个）在ReDim ccAddresses(0 To ccRecipients.Count - 1)行吐错误，

 Private Sub AddUniqueItemToCollectionzz(ByVal value As String, ByVal items As Collection) On Error Resume Next items.Add value, Key:=value On Error GoTo 0 End Sub Sub Sampletest() Dim toRecipients As Collection Set toRecipients = New Collection Dim ccRecipients As Collection Set ccRecipients = New Collection Dim cc2Recipients As Collection Set cc2Recipients = New Collection '===============Copy primary email addresses============= With toRecipients For Each cell In Range("H1:H350") If cell.value Like "*@*.*" Then AddUniqueItemToCollectionzz cell, toRecipients End If Next End With ReDim toAddresses(0 To toRecipients.Count - 1) Dim toAddress As Variant, toItem As Long For Each toAddress In toRecipients toAddresses(toItem) = CStr(toAddress) toItem = toItem + 1 Next Dim sendToPrim As String sendToPrim = Join(toAddresses, ";") '=====================Copy cc email addresses====================== With ccRecipients For Each cell In Range("J1:J350") If cell.value Like "*@*.**" Then AddUniqueItemToCollectionzz cell, ccRecipients End If Next End With ReDim ccAddresses(0 To ccRecipients.Count - 1) Dim ccAddress As Variant, ccItem As Long For Each ccAddress In ccRecipients ccAddresses(ccItem) = CStr(ccAddress) ccItem = ccItem + 1 Next Dim sendToCC As String sendToCC = Join(ccAddresses, ";") '====================Copy cc2 email addresses================ With cc2Recipients For Each cell In Range("A1:a350") If cell.value Like "*.uSA.TACO*" Then AddUniqueItemToCollectionzz cell, cc2Recipients End If Next End With ReDim cc2Addresses(0 To cc2Recipients.Count - 1) Dim cc2Address As Variant, cc2Item As Long For Each ccAddress In cc2Recipients cc2Addresses(cc2Item) = CStr(cc2Address) cc2Item = cc2Item + 1 Next Dim sendToCC2 As String sendToCC2 = Join(cc2Addresses, ";") 

Answer 1

当使用Dim(x to y)或ReDim(x to y) y进行尺寸Dim(x to y)或重新尺寸Dim(x to y) y必须大于或等于x 。 因此，通过在ReDim ccAddresses(0 To ccRecipients.Count - 1)语句之前添加以下行来检查您的代码。

 Debug.Assert ccRecipients.Count >0