User Tools

Site Tools


vba:functions:firstvalue

Table of Contents

[VBA] firstValue()

firstValue gibt den ersten Eintrag der nicht NULL ist zurück. Sie ist sehr gut geeignet um aus Queries zuzugreifen Die Funktion funktioniert auch mit Objekten

Version 1.2.0 - 18.05.2016

Beispiele

Für die Ausgabe der Resultate verwendete ich die Funktion [VBA] print_r()
d firstValue(Null, Null, new RegExp)
<IRegExp2>  (
    [Pattern] => <String> ''
    [Global] => <Boolean> False
    [IgnoreCase] => <Boolean> False
    [Multiline] => <Boolean> False
)
 
d firstValue(Null, 0, 1, 2)
<Integer> 0
 
d firstValue(Null, "", "CHF", "EUR")
<String> 'CHF'
 
d firstValue(Null, "", Empty , Nothing)
<Empty> 

Code

udf_firstvalue.bas
Attribute VB_Name = "udf_firstValue"
'-------------------------------------------------------------------------------
'File         : udf_firstValue.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/firstValue
'Environment  : VBA 2010 +
'Version      : 1.2.0
'Name         : firstValue
'Author       : Stefan Erb (ERS)
'History      : 16.10.2015     Prüfung auf Nothing ergänzt. Als Null gilt jetzt Null oder Nothing
'               18.05.2016     Empty wird neu auch als Null gewertet
'-------------------------------------------------------------------------------
Option Explicit
 
'/**
' * gibt den ersten Eintrag der nicht NULL ist zurück.
' * Ist sehr gut geeignet um aus Queries zuzugreiffen
' * Die Funktion funktioniert auch mit Objekten
' * @return Variant
' * @example:
' * ?firstValue(null, null,13,14, null)  //Rückgabewert 13
' */
Public Function firstValue(ParamArray itemS() As Variant) As Variant
    For Each firstValue In itemS
        If IsObject(firstValue) Then
            If Not firstValue Is Nothing Then Exit For
        Else
            If Not NZ(firstValue, Empty) = Empty Then Exit For
        End If
    Next
End Function
 
vba/functions/firstvalue.txt · Last modified: 07.10.2016 11:24:23 by yaslaw