User Tools

Site Tools


vba:functions:arrayremoveitem

[VBA] arrayRemoveItem()

Entfernt ein einzelnes Item aus einem Array

Version 1.0.1 - 04.09.2019

Beispiele

d arrayRemoveItem(array("a", "b", "c"), 1)
<Variant()>  (
    [0] => <String> 'a'
    [1] => <String> 'c'
)

Code

udf_arrayremoveitem.bas
Attribute VB_Name = "udf_arrayRemoveItem"
'-------------------------------------------------------------------------------
'File         : udf_arrayRemoveItem.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba
'Environment  : VBA 2010 +
'Version      : 1.0.1
'Name         : arrayRemoveItem
'Author       : Stefan Erb (ERS)
'History      : 04.11.2016 - ERS - Creation
'               04.09.2019 - ERS - Array() durch emptyArrayVariant ersetzt
'-------------------------------------------------------------------------------
 
Option Explicit
 
Private Declare Function emptyArrayVariant Lib "oleaut32" Alias "SafeArrayCreateVector" (Optional ByVal vt As VbVarType = vbVariant, Optional ByVal lLow As Long = 0, Optional ByVal lCount As Long = 0) As Variant()
 
'/**
'* Entfernt ein Eintrag aus einem Array und verkrzt diesen
' * @param  Variant Der zu verkrzende Array
' * @param  Long    Index der gelscht werden soll
' * @param  Variant
' */
Public Function arrayRemoveItem(ByVal iArray As Variant, ByVal iIndex As Long) As Variant
    Dim retArr As Variant: ref retArr, iArray
    'Es ist kein Array -> Original zurckgeben
    If Not IsArray(iArray) Then GoTo Exit_Handler
    'Der zulschende Index ist ausserhlab des Arrays -> Original zurckgeben
    If iIndex < LBound(iArray) Or UBound(iArray) < iIndex Then GoTo Exit_Handler
    'Der Originalarray hat nur einen Eintrag -> leerer Array zurckgeben
    If LBound(iArray) = UBound(iArray) Then retArr = emptyArrayVariant():         GoTo Exit_Handler
 
    'Ab dem zu lschenden ndex alles um eins Nach vorne schieben
    Dim i As Long: For i = iIndex To UBound(iArray) - 1
        retArr(i) = iArray(i + 1)
    Next i
    'Den Array verkrzen
    ReDim Preserve retArr(LBound(iArray) To UBound(iArray) - 1)
 
Exit_Handler:
    ref arrayRemoveItem, retArr
    Exit Function
End Function
 
vba/functions/arrayremoveitem.txt · Last modified: 04.09.2019 11:54:13 by yaslaw