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 verkürzt diesen ' * @param Variant Der zu verkürzende Array ' * @param Long Index der gelöscht 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 zurückgeben If Not IsArray(iArray) Then GoTo Exit_Handler 'Der zulöschende Index ist ausserhlab des Arrays -> Original zurückgeben If iIndex < LBound(iArray) Or UBound(iArray) < iIndex Then GoTo Exit_Handler 'Der Originalarray hat nur einen Eintrag -> leerer Array zurückgeben If LBound(iArray) = UBound(iArray) Then retArr = emptyArrayVariant(): GoTo Exit_Handler 'Ab dem zu löschenden 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 verkürzen ReDim Preserve retArr(LBound(iArray) To UBound(iArray) - 1) Exit_Handler: ref arrayRemoveItem, retArr Exit Function End Function