如果元素是某个值，删除数组中的元素VBA

Question

我有一个全局数组，prLst()，它可以是可变长度的。它需要数字作为字符串"1"到Ubound(prLst)。但是，当用户输入"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中的元素？

---

注：这是一个更大的程序，对此的描述可以在这里找到的一部分：Sorting Groups of Rows Excel VBA Macro

Answer 1

数组是具有一定尺寸的结构。您可以使用vba中的动态数组，您可以使用ReDim进行缩小或增长，但不能删除中间的元素。这不是从你的样品清楚如何你的阵列功能上工作或你如何确定索引位置（eachHdr），但你基本上有3个选择

（A）编写自定义“删除”功能，为您的阵列状（未经测试）

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 

Answer 2

添加或删除元素来创建数组的时候，为什么不跳过的0和保存自己不必担心时间他们以后？如上所述，数组不适合删除。

Answer 3

我是很新，VBA & Excel中 - 只有做这个做了3个月左右 - 我想我会在这里分享我的阵列重复数据删除方法，这个职位似乎是有关它：

这如果是分析管道数据的较大应用程序的一部分，则编码 - 管道在xxxx.1，xxxx.2，yyyy.1，yyyy.2 ....格式的数字表中列出。所以这就是为什么所有的字符串操作存在。 基本上它只收集一次管道号，而不是.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 

使用一堆消息框来调试atm - 我确定你会改变它来适应你自己的工作。

我希望人们发现这很有用， 问候 乔

Answer 4

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 

Answer 5

删除数组中的元素，如果元素有一定的价值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, ",") 

我经常操纵1D-阵列与Join /拆分 ，但如果你要删除的多维一定的价值，我建议你改变这些阵列到一维数组这样

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. 

Answer 6

这里是一个代码示例使用CopyMemory函数来完成这项工作。

它被认为是“快得多”（取决于数组的大小和类型...）。

我不是作家，但我进行了测试：

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 

Answer 7

我知道这是旧的，但这里是我想出了的时候，我不喜欢，我发现的那些解决方案。

-loop通过添加各元件和部分分隔为一个字符串，所述阵列（变体），除非它匹配要删除 - 然后拆分在分隔

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, ":-:") 

显然使用该字符串的一个的字符串会产生一些限制，比如需要确保数组中已有的信息，并且原因是此代码使第一个数组元素变为空白，但它确实满足了我的需要，并且稍微多了一些工作就可以使用更多功能。