如果元素是特定值VBA，则删除数组中的元素
我有一个全局数组， prLst()可以变长。 它取数字作为string"1"到Ubound(prLst) 。 但是，当用户input"0" ，我想从列表中删除该元素。 我有写下面的代码来执行此操作：
count2 = 0 eachHdr = 1 totHead = UBound(prLst) Do If prLst(eachHdr) = "0" Then prLst(eachHdr).Delete count2 = count2 + 1 End If keepTrack = totHead - count2 'MsgBox "prLst = " & prLst(eachHdr) eachHdr = eachHdr + 1 Loop Until eachHdr > keepTrack
这不起作用。 如果元素为"0"如何有效地删除数组prLst的元素？
注意：这是一个更大的程序的一部分，可以在这里find描述： 对行进行sortingExcel VBAmacros
数组是具有一定大小的结构。 您可以使用vba中的dynamic数组，您可以使用ReDim进行缩小或增长，但不能删除中间的元素。 从样本中不清楚你的数组是如何工作的，或者你如何确定索引位置（eachHdr），但是你基本上有3个选项
（A）为你的数组写一个自定义的“删除”函数（未经testing）
Public Sub DeleteElementAt(Byval index As Integer, Byref prLst as Variant) Dim i As Integer ' Move all element back one position For i = index + 1 To UBound(prLst) prLst(i - 1) = prLst(i) Next ' Shrink the array by one, removing the last one ReDim Preserve prLst(Len(prLst) - 1) End Sub
（B）简单地将“虚拟”值设置为值，而不是实际删除元素
If prLst(eachHdr) = "0" Then prLst(eachHdr) = "n/a" End If
（C）停止使用数组并将其更改为VBA.Collection。 集合是一个（唯一的）键/值对结构，您可以在其中自由添加或删除元素
Dim prLst As New Collection
Sub DelEle(Ary, SameTypeTemp, Index As Integer) '<<<<<<<<< pass only not fixed sized array (i don't know how to declare same type temp array in proceder) Dim I As Integer, II As Integer II = -1 If Index < LBound(Ary) And Index > UBound(Ary) Then MsgBox "Error.........." For I = 0 To UBound(Ary) If I <> Index Then II = II + 1 ReDim Preserve SameTypeTemp(II) SameTypeTemp(II) = Ary(I) End If Next I ReDim Ary(UBound(SameTypeTemp)) Ary = SameTypeTemp Erase SameTypeTemp End Sub Sub Test() Dim a() As Integer, b() As Integer ReDim a(3) Debug.Print "InputData:" For I = 0 To UBound(a) a(I) = I Debug.Print " " & a(I) Next DelEle a, b, 1 Debug.Print "Result:" For I = 0 To UBound(a) Debug.Print " " & a(I) Next End Sub
我很新vba＆excel – 只做了约3个月 – 我想我会在这里分享我的重复数据删除方法，因为这篇文章似乎与它有关：
此代码是分析pipe道数据的较大应用程序的一部分 – pipe道以xxxx.1，xxxx.2，yyyy.1，yyyy.2 ….格式编号的工作表中列出。 所以这就是为什么所有的string操作存在。 基本上它只收集一次pipe道号，而不是.2或.1部分。
With wbPreviousSummary.Sheets(1) ' here, we will write the edited pipe numbers to a collection - then pass the collection to an array Dim PipeDict As New Dictionary Dim TempArray As Variant TempArray = .Range(.Cells(3, 2), .Cells(3, 2).End(xlDown)).Value For ele = LBound(TempArray, 1) To UBound(TempArray, 1) If Not PipeDict.Exists(Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2))) Then PipeDict.Add Key:=Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2)), _ Item:=Left(TempArray(ele, 1), Len(TempArray(ele, 1) - 2)) End If Next ele TempArray = PipeDict.Items For ele = LBound(TempArray) To UBound(TempArray) MsgBox TempArray(ele) Next ele End With wbPreviousSummary.Close SaveChanges:=False Set wbPreviousSummary = Nothing 'done early so we dont have the information loaded in memory
使用一堆消息框来debuggingatm – 确定你会改变它来适应你自己的工作。
我希望人们觉得这个有用，乔
如果元素是特定值VBA，则删除数组中的元素
要删除一个数组中的元素，你可以这样编码
For i = LBound(ArrValue, 2) To UBound(ArrValue, 2) If [Certain condition] Then ArrValue(1, i) = "-----------------------" End If Next i StrTransfer = Replace(Replace(Replace(join(Application.Index(ArrValue(), 1, 0), ","), ",-----------------------,", ",", , , vbBinaryCompare), "-----------------------,", "", , , vbBinaryCompare), ",-----------------------", "", , , vbBinaryCompare) ResultArray = join( Strtransfer, ",")
我经常使用Join / Split操作1D数组，但是如果您必须在多维中删除某个值，build议您将这些数组更改为1D数组
strTransfer = Replace(Replace(Replace(Replace(Names.Add("A", MultiDimensionArray), Chr(34), ""), "={", ""), "}", ""), ";", ",") 'somecode to edit Array like 1st code on top of this comment 'then loop through this strTransfer to get right value in right dimension 'with split function.
这里是一个使用CopyMemory函数来完成这个工作的代码示例。
据说“更快”（取决于数组的大小和types…）。
我不是作者，但是我testing了它：
Sub RemoveArrayElement_Str(ByRef AryVar() As String, ByVal RemoveWhich As Long) '// The size of the array elements '// In the case of string arrays, they are '// simply 32 bit pointers to BSTR's. Dim byteLen As Byte '// String pointers are 4 bytes byteLen = 4 '// The copymemory operation is not necessary unless '// we are working with an array element that is not '// at the end of the array If RemoveWhich < UBound(AryVar) Then '// Copy the block of string pointers starting at ' the position after the '// removed item back one spot. CopyMemory ByVal VarPtr(AryVar(RemoveWhich)), ByVal _ VarPtr(AryVar(RemoveWhich + 1)), (byteLen) * _ (UBound(AryVar) - RemoveWhich) End If '// If we are removing the last array element '// just deinitialize the array '// otherwise chop the array down by one. If UBound(AryVar) = LBound(AryVar) Then Erase AryVar Else ReDim Preserve AryVar(LBound(AryVar) To UBound(AryVar) - 1) End If End Sub
我知道这是旧的，但是当我不喜欢我find的那个时，我提出了这个解决scheme。
绕过数组（Variant）将每个元素和一些分隔符添加到一个string，除非它匹配您想要删除的那个 – 然后拆分分隔符上的string
tmpString="" For Each arrElem in GlobalArray If CStr(arrElem) = "removeThis" Then GoTo SkipElem Else tmpString =tmpString & ":-:" & CStr(arrElem) End If SkipElem: Next GlobalArray = Split(tmpString, ":-:")
显然，string的使用会产生一些限制，比如需要确认数组中已经存在的信息，而且这个代码使得第一个数组元素变成空白的，但是这样做却是我所需要的，只需要多做一些工作就可以了更通用。
在创build数组的时候，为什么不跳过0来节省自己以后担心的时间？ 如上所述，数组不适合删除。