====== [VBA] arrayShift() ======
Analog zu array_shift() aus PHP. Der erste Wert wird zurückgegeben und aus dem Array entfernt
Liefert den ersten Wert von array , verschiebt die anderen Werte hinunter, und verkürzt array um ein Element.
Alle numerischen Schlüssel werden so modifiziert, dass bei null zu zählen begonnen wird.
Ist array leer (oder kein Array), wird NULL zurückgegeben.
Wenn man den Returnwert als 2ten Paramater abgreift, muss man sich nicht mehr darum kümmern, ob er ein Objekt ist oder nicht.
Will man das nicht, kann auch der Boolean-Parameter um den IndexReset zu steuern an 2ter Stelle mitgeben. Ist als oValue mit einem
Boolean belegt, dann wird das als iIndexReset intepretiert
{{:vba:functions:udf_arrayshift.bas|Download udf_arrayshift.bas}}
===== Definition =====
value = arrayShift(array [,value][,indexReset])
arrayShift array [,value][,indexReset]
Public Function arrayShift( _
ByRef ioArray As Variant, _
Optional ByRef oValue As Variant = Null, _
Optional ByVal iIndexReset As Variant = True _
) As Variant
==== Parameter-Liste ====
* **ioArray** Array, der die Daten enthält
* **oValue** Return-Wert / indexReset
* **iIndexReset** Angabe, ob der Index beim reduzierten Array zurückgesetzt werden soll
==== Rückgabewerte ====
Des erste Element
===== Beispiele =====
> Für die Ausgabe der Resultate verwendete ich die Funktion [[vba:functions:print_r:index]]
value = arrayShift(values) 'Einfach erste rausnehmen
arrayShift values, value 'dito
value = arrayShift(values, false) 'Index wird nicht zurückgesetzt
arrayShift(values, value, false) 'dito
arrayShift values 'Erster wird entfernt und weggeworfen, Index zurückgesetzt
arrayShift values, false 'Erster wird entfernt und weggeworfen, Index bleibt erhalten
==== Normale anwendung ====
Public Sub testArrayShift()
Dim a As Variant: a = Array("a", "b", "c", "d")
Dim first As String: first = arrayShift(a)
print_rm first, a
End Sub
a
(
[0] => b
[1] => c
[2] => d
)
==== Mit referenzierter Out-Variable, ohne rücksetzen des Index ====
Public Sub testArrayShift()
Dim a As Variant: a = Array(New regExp, New FileSystemObject, New Field)
Dim first As Object
arrayShift a, first, False
print_rm first, a
End Sub
(
[Pattern] =>
[Global] => False
[IgnoreCase] => False
[Multiline] => False
)
(
[1] =>
[2] => (
[OrdinalPosition] => 0
[name] =>
[type] => 0
)
)
===== Code =====
'-------------------------------------------------------------------------------
'File : udf_arrayShift.bas
' Copyright mpl by ERB software
' All rights reserved
' http://wiki.yaslaw.info/dokuwiki/doku.php/vba
'Environment : VBA 2010 +
'Version : 1.1.1
'Name : list
'Author : Stefan Erb (ERS)
'History : 23.06.2014 - ERS - Creation
' 23.06.2014 - ERS - Parametervielfalt eingeführt
'-------------------------------------------------------------------------------
Option Explicit
'/**
' * analog zu array_shift aus PHP
' * liefert den ersten Wert von array , verschiebt die anderen Werte hinunter, und verkürzt array um ein Element.
' * Alle numerischen Schlüssel werden so modifiziert, dass bei null zu zählen begonnen wird.
' * Ist array leer (oder kein Array), wird NULL zurückgegeben.
' * Wenn man den Returnwert als 2ten Paramater abgreift, muss man sich nicht mehr darum kümmern, ob er ein Objekt ist oder nicht.
' * Will man das nicht, kann auch der Boolean-Parameter um den IndexReset zu steuern an 2ter Stelle mitgeben. Ist als oValue mit einem
' * Boolean belegt, dann wird das als iIndexReset intepretiert
' *
' * value = arrayShift(array [,value][,indexReset])
' * arrayShift array [,value][,indexReset]
' *
' * @example value = arrayShift(values) 'Einfach erste rausnehmen
' * @example arrayShift values, value 'dito
' * @example value = arrayShift(values, false) 'Index wird nicht zurückgesetzt
' * @example arrayShift(values, value, false) 'dito
' * @example arrayShift values 'Erster wird entfernt und weggeworfen, Index zurückgesetzt
' * @example arrayShift values, false 'Erster wird entfernt und weggeworfen, Index bleibt erhalten
' *
' * @param Array Array, der die Daten enthält
' * @param Variant Return-Wert / indexReset
' * @param Variant Angabe, ob der Index beim reduzierten Array zurückgesetzt werden soll
' * @retrun Varaint
' */
Public Function arrayShift(ByRef ioArray As Variant, _
Optional ByRef oValue As Variant = Null, _
Optional ByVal iIndexReset As Variant = True _
) As Variant
On Error GoTo Err_Handler
'Erster Wert auslesen
ref arrayShift, ioArray(LBound(ioArray)) 'Erster Wert ermitteln
If VarType(oValue) = vbBoolean Then
iIndexReset = oValue 'oValue ist nicht oValue, sondern iIndexReset
Else
ref oValue, arrayShift 'oValue abfüllen
End If
'Alle anderen Werte um eins nach oben schieben
Dim retArr() As Variant
Dim idx As Integer
If iIndexReset Then
Dim delta As Integer: delta = LBound(ioArray) + 1
ReDim retArr(0 To UBound(ioArray) - delta)
For idx = delta To UBound(ioArray): ref retArr(idx - delta), ioArray(idx): Next idx
Else
ReDim retArr(LBound(ioArray) + 1 To UBound(ioArray))
For idx = LBound(retArr) To UBound(retArr): ref retArr(idx), ioArray(idx): Next idx
End If
ioArray = retArr
Exit_Handler:
Exit Function
Err_Handler:
arrayShift = Null
End Function
'/**
' * Bei einer Variablenübergabe muss immer unterscheiden werden, ob es ein Objekt ist oder nicht.
' * Diese Sub nimmt einem die Arbeit ab
' * ref(oNode, iNode)
' * @param Variant Variable, die den Wert bekommen soll
' * @param Variant Ret Wert selber
' */
Private Sub ref(ByRef oNode As Variant, ByRef iNode As Variant)
If IsObject(iNode) Then
'Objekte als referenz übergeben
Set oNode = iNode
Else
'Je nach Datentyp der erwartet wird handeln.
Select Case TypeName(oNode)
Case "String": oNode = CStr(Nz(iNode))
Case "Integer": oNode = CInt(Nz(iNode))
Case "Long": oNode = CLng(Nz(iNode))
Case "Double": oNode = CDbl(Nz(iNode))
Case "Byte": oNode = CByte(Nz(iNode))
Case "Decimal": oNode = CDec(Nz(iNode))
Case "Currency": oNode = CCur(Nz(iNode))
Case "Date": oNode = CDate(Nz(iNode))
Case "Nothing":
Case Else: oNode = iNode
End Select
End If
End Sub