有没有一种简单的方法可以通过索引从数组中删除特定的数据集?
例:
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,斯泰西,西雅图
我现在从之前的计算中知道我不再需要索引 1的 Bob,我想删除他的记录
有没有像下面这样简单的事情?
ReDim Preserve array(UBound(array) - 1)
array.delete(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
用于 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
简单过程调用靠近您的帖子,但返回一个从 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