Differences

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

--- vba:functions:arrayshift [03.07.2014 11:37:55]
yaslaw
+++ vba:functions:arrayshift [08.07.2014 11:54:43] (current)
yaslaw [[VBA] arrayShift()]
@@ Line 1: / Line 1: @@
 ====== [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])
@@ Line 23: / 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