Differences

This shows you the differences between two versions of the page.

--- vba:functions:arrayshift [03.07.2014 11:36:42]
yaslaw created
+++ vba:functions:arrayshift [08.07.2014 11:54:43] (current)
yaslaw [[VBA] arrayShift()]
@@ Line 2: / Line 2: @@
 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, _
@@ Line 15: / Line 26: @@
 ==== 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

Differences

Page Tools