如果元素是某個值，刪除數組中的元素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, ":-:") 

顯然使用該字符串的一個的字符串會產生一些限制，比如需要確保數組中已有的信息，並且原因是此代碼使第一個數組元素變爲空白，但它確實滿足了我的需要，並且稍微多了一些工作就可以使用更多功能。