Как я могу удалить элемент из массива?

У меня есть файл Excel, содержащий контактные адреса электронной почты, например, ниже.

ABC 1 Shop Supervisor Assistant 2 A [email protected] [email protected] 3 B [email protected] 4 C [email protected] [email protected] 5 D 6 E [email protected] [email protected] 

Я создал пользовательскую форму, в которой пользователь может выбрать, какую роль они хотят по электронной почте (Supervisor или Assistant), или они могут отправлять по электронной почте, если необходимо, а затем есть код, который берет адреса электронной почты для этих ролей, открывает новое письмо и добавляет адреса электронной почты в разделе «Кому». Этот код выглядит следующим образом:

  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, eg 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 - ie 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 - ie 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 

То, что я хочу сделать, это получить, так что, если в приведенном выше примере нет контакта, например, в магазине «D», появляется окно с сообщением о том, что контакта нет. Для этого я начал использовать массив:

 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». Поскольку этот код просматривается во всех Supervisors, то есть он запускает столбец B, добавляя адреса электронной почты к переменной «To_Recipients», если есть адрес электронной почты и добавление магазина в массив «NoContacts», если этого не происходит, затем продолжается Помощникам, мне нужно знать, как удалить элемент из массива.

Например, вышеприведенный код добавит Shop «B» в массив, потому что у него нет Supervisor, но поскольку у него есть помощник, мне нужно удалить Shop «B» из массива, когда он запускает код помощника, тогда как Shop «D» останется в массиве, потому что у него нет ни супервизора, ни помощника. Помните, что я пытаюсь отобразить список магазинов, у которых нет контакта, и поэтому они не включены в электронную почту.

Это имеет смысл в моем сознании, однако, пожалуйста, дайте мне знать, если я не объясню это четко.

Итак, чтобы уточнить, как я могу удалить определенный элемент из массива?

Ваш код можно было бы упростить, только зациклив на строки один раз и одновременно проверить как супервизор, так и помощник:

 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 

Однако, чтобы ответить на ваш конкретный вопрос, нет встроенного способа удалить один или несколько элементов из массива. Вы должны создать функцию или подпрограмму для этого: петля над массивом и скопировать ее элементы во второй массив, исключая элементы, которые нужно удалить.

Пример:

 Sub Tester() Dim arr arr = Split("A,B,C,D", ",") Debug.Print "Before:", Join(arr, ",") RemoveItem arr, "A" Debug.Print "After:", Join(arr, ",") End Sub Sub RemoveItem(ByRef arr, v) Dim rv(), i As Long, n As Long, ub As Long, lb As Long lb = LBound(arr): ub = UBound(arr) ReDim rv(lb To ub) For i = lb To ub If arr(i) <> v Then rv(i - n) = arr(i) Else n = n + 1 End If Next 'check bounds before resizing If (ub - n) >= lb Then ReDim Preserve rv(lb To ub - n) arr = rv End Sub 
  • Отправка нескольких писем с помощью разных приложений
  • Html table конвертировать как excel и отправлять по электронной почте
  • VBA Excel Отправка отдельных писем
  • VBA снимает скриншот отфильтрованного Excel и отправляет каждую строку в итерации
  • Perl: прочитайте письмо и используйте контент сообщения как stdin для обновления excel
  • Excel 2010 Вставить диапазон и изображение в Outlook
  • VBA отправляет электронную почту через IBM Notes не работает?
  • Создание полностью форматированного письма с таблицами в VBA
  • VBA: Отправить письмо IBM Notes (с приложением) отдельным получателям?
  • Код Excel для создания электронной почты с Outlook 2013 не работает с Outlook 2016?
  • Сценарий приложения Gmail Добавить BCC из таблицы
  • Interesting Posts

    как динамически наращивать ячейки с помощью Microsoft.Office.Interop.Excel

    Формула GETPIVOTDATA, чтобы вернуть общее количество предмета в течение определенного месяца

    импортируя CSV excel в phpmyadmin, тогда «?» вводится автоматически

    Ускорение времени запуска VSTO Excel в пользовательской настройке документа, использующей WPF

    Пользовательская функция не распознана

    VBScript для копирования содержимого текстового файла в уже существующую таблицу Excel

    возвращать текстовое значение, когда условия выполняются в excel

    Код Excel VBA для MID / Разделение текста в ячейке на основе фиксированной ширины

    Проблема с пакетом SSIS с диспетчером подключений Excel

    Datagridview для конкретной ячейки excel

    как подсчитать увеличение полосы прибыли?

    Как я могу консолидировать этот код?

    Заполнение массива в VBA из разных частей таблицы

    Обнаружение зависимых клеток с другого листа

    Чтение пустой ячейки листа Excel

    Давайте будем гением компьютера.