Удаление элементов в массиве, если элемент имеет определенное значение VBA

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

при создании массива, почему бы просто не пропустить 0 и сэкономить время, чтобы беспокоиться о них позже? Как упоминалось выше, массивы не подходят для удаления.

Я довольно новичок в vba & excel - только делал это около 3 месяцев - Я думал, что поделюсь своим методом де-дублирования массива здесь, поскольку этот пост кажется ему актуальным:

этот код, если часть большего приложения, которое анализирует данные канала- Трубы перечислены в листе с номером в xxxx.1, xxxx.2, гггг.1, гггг.2 .... формат. так вот почему все манипуляции со строками существуют. в основном он собирает только номер трубы только один раз, а не .2 или .Один часть.

        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-im уверен, что вы измените его в соответствии с вашей собственной работой.

Я надеюсь, что люди найдут это полезным, С уважением Джо!--2-->

удаление элементов в массиве, если элемент имеет определенное значение 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 / Split но если вам нужно удалить определенное значение в нескольких измерениях, я предлагаю вам изменить этот массив на 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 функция для выполнения задания.

предположительно "намного быстрее" (в зависимости от размера и типа массива...).

Я не автор, но я проверял это :

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

- цикл через массив (вариант) добавление каждого элемента и некоторого делителя в строку, если он не соответствует тому, который вы хотите удалить - Тогда разделите строку на разделитель

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

очевидно, что использование строк создает некоторые ограничения, например, нужно быть уверенным в информации, уже в массиве, и как этот код делает первый элемент массива пустой, но он делает то, что мне нужно, и с немного большей работой он может быть более универсальным.