Массивы VBA в Excel. Существует ли простой способ удаления набора данных по индексу?

Question

Есть ли простой способ удалить определенный набор данных из массива по индексу?

Пример:

Dim array() as string

ReDim array(2,2)

array(0,0) = "abc"
array(0,1) = "Peter"
array(0,2) = "New York"

array(1,0) = "xyz"
array(1,1) = "Bob"
array(1,2) = "Los Angeles"

array(2,0) = "klm"                       ' edited (enumeration error in OP)
array(2,1) = "Stacey"
array(2,2) = "Seattle"

Так что мой массив показывает на
0: abc, Питер, Нью-Йорк
1: xyz, Боб, Лос-Анджелес
2: KLM, Стейси, Сиэтл

Теперь я знаю по предыдущему расчету, что Бобу больше не нужен index 1 , и я хочу удалить его запись

Есть ли что-то простое, подобное следующему?

ReDim Preserve array(UBound(array) - 1)
array.delete(1)

Answer 1

попробуйте это для 1d массивов

Sub test()
Dim strr As String
strr = "0|1|2|3|5"
wArr = Split(strr, "|")
d = DeleteElementAt(2, strr)
End Sub


Function DeleteElementAt(ByVal index As Integer, ByRef prLsts, strDelimeter) As String
       Dim i As Integer
        Dim newLst
        ' Move all element back one position
        prLst = Split(prLsts, strDelimeter)
        If UBound(prLst) > 0 Then
            ReDim newLst(UBound(prLst) - 1)
            For i = 0 To UBound(prLst)
                If i <> index Then newLst(y) = prLst(i): y = y + 1
            Next
            DeleteElementAt = Join(newLst, strDelimeter)
        Else
            DeleteElementAt = prLsts
        End If

End Function

для двумерного массива

Function Delete2dElementAt(ByVal index As Integer, ByRef prLsts) As Variant
       Dim i As Integer
        Dim newLst
        ' Move all element back one position
        prLst = prLsts
        If index > UBound(prLst) Then MsgBox "overcome index": Exit Function
        If UBound(prLst) > 0 Then
            ReDim newLst(UBound(prLst) - 1, UBound(prLst, 2))
            For i = 0 To UBound(prLst)
                If i <> index Then
                    For Z = LBound(prLst, 2) To UBound(prLst, 2)
                        newLst(y, Z) = prLst(i, Z)
                    Next Z
                    y = y + 1
                End If
            Next
            Delete2dElementAt = newLst
        Else
            Delete2dElementAt = prLsts
        End If

End Function

Answer 2

Простой вызов процедуры рядом с вашим постом, но с возвратом массива на основе 1

Используя расширенные возможности функции Application.Index, я демонстрирую подход, близкий к вашему желаемому псевдо-метод array.delete(1) в OP:

  delArr arr, 2            ' see section [1] in the Example call below

, где

• delArr - вызывающая процедура,
• arr - имя массива (don '• использовать имя зарезервированной функции до крестить ваш массив!) и
• 2 - номер строки элемента, так как Application.Index возвращает только 1-based arrays.

Пример вызова

Sub DelGivenElementNumber()
  Dim arr() As Variant, i As Long
  ReDim arr(1 To 3, 1 To 3)                 ' redimension to 1-based array :-)
  arr(1, 1) = "abc": arr(1, 2) = "Peter": arr(1, 3) = "New York"
  arr(2, 1) = "xyz": arr(2, 2) = "Bob": arr(2, 3) = "Los Angeles"
  arr(3, 1) = "klm": arr(3, 2) = "Stacey": arr(3, 3) = "Seattle"

' --------------------------------
' [1] delete element row  number 2          ' i.e. xyz|Bob|Los Angeles
' --------------------------------
  delArr arr, 2

' [2] optionally: check remaining element rows (now 1-based!)
  For i = LBound(arr) To UBound(arr)
      Debug.Print i, dispArrElements(arr, i)
  Next i
End Sub

Результат реструктурированного массива на основе 1 в непосредственном окне VBE:

1   abc, Peter, New York
2   klm , Stacey, Seattle

Основная процедура delArr

Основная процедура delArr представляет собой только один вкладыш и имеет только два аргумента:

1. сам массив данных передал по ссылке и
2. номер 'строки', подлежащей удалению (на основе 1, например, 2 представляет второй элементстрока nt):

Sub delArr(arr, r As Long)
    arr = Application.Index(arr, validRows(arr, r), allCols(UBound(arr, 2)))
End Sub

Вспомогательные функции

Основная процедура использует две вспомогательные функции для получения массивов с оставшимися номерами строк и столбцов (здесь: Array(1,2,3) для трех столбцов).

Function validRows(arr, ByVal n&) As Variant()
' Purpose: get 0-based 1-dim Array(1,3), i.e. all remaining original row numbers counting from 1, omitting 2
  Dim i&, nRows&
  nRows = UBound(arr) - LBound(arr) + 1                           ' original row number
  ReDim tmp(0 To nRows - 2)                                       ' zero-based tmp counter: -1, omitting element n: -1 ~~> -2
  For i = 1 To n - 1                                              ' collect elements before element n
      tmp(i - 1) = i
  Next i
  For i = n To nRows - 1                                          ' collect elements after element n
      tmp(i - 1) = i + 1                                          ' count old row numbers, but with reduced tmp counter
  Next i
'  Debug.Print Join(tmp, "|")
  validRows = Application.Transpose(tmp)                          ' return array of found row numbers
End Function

Function allCols(ByVal n&) As Variant()
' Purpose: get 0-based 1-dim Array(1,2,... n), i.e. all column numbers
  allCols = Application.Transpose(Evaluate("row(1:" & n & ")"))
End Function

Дополнительная функция для отображения результатов

Использование функции Join для отображения одного элемента строки со всеми тремястолбцы вашего примера (см. раздел [2] в примере вызова):

Function dispArrElements(arr, r As Long) As String
  dispArrElements = Join(Application.Transpose(Application.Transpose(Application.Index(arr, r, 0))), ", ")
End Function