Yaslaw.Info

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== [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 =====
<code>value = arrayShift(array [,value][,indexReset])
arrayShift array [,value][,indexReset]</code>
<code vb>Public Function arrayShift( _
        ByRef ioArray As Variant, _
        Optional ByRef oValue As Variant = Null, _
        Optional ByVal iIndexReset As Variant = True _
) As Variant</code>
==== 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]]

<code vb>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</code>

==== Normale anwendung ====
<code vb>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</code>
<code><String> a
<Variant()>  (
    [0] => <String> b
    [1] => <String> c
    [2] => <String> d
)</code>

==== Mit referenzierter Out-Variable, ohne rücksetzen des Index ====
<code vb>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</code>
<code><IRegExp2>  (
    [Pattern] => <String> 
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> False
    [Multiline] => <Boolean> False
)
<Variant()>  (
    [1] => <FileSystemObject> 
    [2] => <Field2>  (
        [OrdinalPosition] => <Integer> 0
        [name] => <String> 

        [type] => <Integer> 0
    )
)</code>
===== Code =====
<code vb udf_arrayshift.bas>'-------------------------------------------------------------------------------
'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<Variant>  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</code>
Yaslaw.Info

User Tools

Site Tools

Page Tools
