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：荷航，史黛西，西雅图

我现在从以前的计算中知道，我不再需要索引1 的Bob，我想删除他的记录

有以下简单的东西吗？

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

Answer 1

尝试使用一维数组

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

用于2D阵列

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函数的高级功能，我演示了一种与OP中所需的伪方法array.delete(1)接近的方法：

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

其中

delArr是调用过程，
arr是数组名称（不要使用保留函数的名称 您的数组！）和
2是元素行号，因为Application.Index仅返回基于 1的数组。

示例呼叫

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

在VBE的即时窗口中基于1的重组数组的结果：

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

主要过程delArr

主过程delArr只是一个一个班轮，并且只有两个参数：

数据数组本身通过引用传递和
要删除的“行”号（从1开始，例如2表示第二个元素行）：

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

Excel VBA数组：是否有一种简单的方法可以通过索引删除数据集？

2 个答案: