我有一个包含联系电子邮件地址的Excel文件，如下所示。
A B C
1 Shop Supervisor Assistant
2 A hulk.hogan@web.com freddie.mercury@web.com
3 B brian.may@web.com
4 C triple.h@web.com roger.taylor@web.com
5 D
6 E randy.orton@web.com john.deacom@web.com
我创建了一个用户表单，用户可以在其中选择他们想要通过电子邮件发送的角色（主管或助理），或者他们可以根据需要通过电子邮件发送这两个角色，然后是那些获取这些角色的电子邮件地址的代码，打开一封新电子邮件，并将电子邮件地址添加到＆＃34; To＆＃34;部分。此代码如下：
Private Sub btnEmail_Click()
Dim To_Recipients As String
Dim NoContacts() As String
Dim objOutlook As Object
Dim objMail As Object
Dim firstRow As Long
Dim lastRow As Long
ReDim NoContacts(1 To 1) As String
' Define the column variables
Dim Supervisor_Column As String, Assistant_Column As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
' Add in the column references to where the email addresses are, e.g. Supervisor is in column K
Supervisor_Column = "K"
Assistant_Column = "M"
' Clear the To_Recipients string of any previous data
To_Recipients = ""
' If the To Supervisor checkbox is ticked
If chkToSupervisor.Value = True Then
With ActiveSheet
' Get the first and last rows that can be seen with the filter
firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' For every row between the first and last
For Row = firstRow To lastRow
' Check if the row is visible - i.e. if it is included in the filter
If Rows(Row).Hidden = False Then
' If it is visible then check to see whether there is data in the cell
If Not IsEmpty(Range(Supervisor_Column & Row).Value) And Range(Supervisor_Column & Row).Value <> 0 Then
' If there is data then add it to the list of To_Recipients
To_Recipients = To_Recipients & ";" & Range(Supervisor_Column & Row).Value
Else
' See whether the shop is already in the array
If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
' If it isn't then add it to the array
NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
End If
End If
End If
' Go onto the next row
Next Row
End With
End If
' If the To Assistant checkbox is ticked
If chkToAssistant.Value = True Then
With ActiveSheet
' Get the first and last rows that can be seen with the filter
firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' For every row between the first and last
For Row = firstRow To lastRow
' Check if the row is visible - i.e. if it is included in the filter
If Rows(Row).Hidden = False Then
' If it is visible then check to see whether there is data in the cell
If Not IsEmpty(Range(Assistant_Column & Row).Value) And Range(Assistant_Column & Row).Value <> 0 Then
' If there is data then add it to the list of To_Recipients
To_Recipients = To_Recipients & ";" & Range(Assistant_Column & Row).Value
Else
' See whether the shop is already in the array
If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
' If it isn't then add it to the array
NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
End If
End If
End If
' Go onto the next row
Next Row
End With
End If
With objMail
.To = To_Recipients
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
' Close the User Form
Unload Me
End Sub
我希望能够做到的是，如果没有联系人，例如在商店＆＃34; D＆＃34;在上面的示例中，出现一个消息框，表示没有联系人。为此，我开始使用数组：
NoContacts
正如您在上面的代码中所看到的那样：
' See whether the shop is already in the array
If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
' If it isn't then add it to the array
NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
End if
如果没有联系人，是否输入了商店信函，例如，如果没有像店铺那样的主管，那么B＆＃34;＆＃34; B＆＃34;在示例中。因为此代码查看所有主管，即它在B列下运行，将电子邮件地址添加到＆＃34; To_Recipients＆＃34;如果有电子邮件地址并将商店添加到＆＃34; NoContacts＆＃34;数组如果没有，那么继续前进到助手，我需要知道如何从数组中删除一个项目。
例如，上面的代码将添加Shop＆＃34; B＆＃34;进入阵列因为它没有主管，但是因为它有一个助手我需要删除Shop＆＃34; B＆＃34;当它运行助手代码时从数组中，而Shop＆＃34; D＆＃34;将留在阵列中，因为它既没有主管也没有助理 - 请记住，我正在尝试显示没有联系的商店列表，因此未包含在电子邮件中。
这在我看来是有道理的，但如果我没有清楚解释，请告诉我。
那么，澄清一下，如何从数组中删除特定项？
答案 0 :(得分：3)
只需循环一次行，并同时检查主管和助手，即可简化您的代码：
android-23要回答您的具体问题，没有内置方法可以从数组中删除一个或多个项目。你可以构建一个函数或子来做到这一点：遍历数组并将其项目复制到第二个数组，不包括要删除的项目。
示例：
Private Sub btnEmail_Click()
'Add in the column references to where the email addresses are
Const Supervisor_Column = "K"
Const Assistant_Column = "M"
Dim To_Recipients As String
Dim NoContacts() As String
Dim objOutlook As Object
Dim objMail As Object
Dim firstRow As Long, lastRow As Long
Dim doSup As Boolean, doAssist As Boolean, eSup, eAssist
Dim bHadContact As Boolean
ReDim NoContacts(1 To 1) As String
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
doSup = chkToSupervisor.Value
doAssist = chkToAssistant.Value
To_Recipients = ""
' If either checkbox is ticked
If doSup Or doAssist Then
With ActiveSheet
firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For Row = firstRow To lastRow
If Not Rows(Row).Hidden Then
bHadContact = False
eSup = Trim(.Cells(Row, Supervisor_Column))
eAssist = Trim(.Cells(Row, Assistant_Column))
If Len(eSup) > 0 And doSup Then
To_Recipients = To_Recipients & ";" & eSup
bHadContact = True
End If
If Len(eAssist) > 0 And doAssist Then
To_Recipients = To_Recipients & ";" & eAssist
bHadContact = True
End If
'no assistant or supervisor - add the shop
If Not bHadContact Then
NoContacts(UBound(NoContacts)) = .Cells(Row, "F").Value
ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1)
End If
End If 'not hidden
Next Row
End With
End If
With objMail
.To = To_Recipients
.Display
End With
If UBound(NoContacts) > 1 Then
MsgBox "One or more stores had no contacts:" & vbCrLf & Join(NoContacts, vbLf), _
vbExclamation
End If
Set objOutlook = Nothing
Set objMail = Nothing
' Close the User Form
Unload Me
End Sub