Differences

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

--- vba:functions:compaire [16.09.2014 11:09:04]
yaslaw [Einfache Werte vergleichen]
+++ vba:functions:compaire [29.04.2015 10:52:23] (current)
yaslaw
@@ Line 1: / Line 1: @@
+<const>
+    version=1.0.1
+    vdate=19.09.2014
+    fname=udf_compaire.bas
+    ns=%NAMESPACE%
+    fpath=/vba/functions
+</const>
+{{keywords>vba,function,compaire,array,object,dictionary}}
+{{description>Eine Funktion zum Vergleichen. Klingt eigentlich unnötig. Doch vergleicht sie alles Mögliche. Arrays untereinander, Dictionaries, Null mit Empty etc.}}
 ====== [VBA] compaire() ======
-Eine Funktion zum Vergleichen. Klingt eigentlich unnötig. Doch vergleicht sie alles Mögliche.
+//Eine Funktion zum Vergleichen. Klingt eigentlich unnötig. Doch vergleicht sie alles Mögliche.
 Arrays untereinander, Dictionaries, Null mit Empty etc.
+//
+==Version %%version%% %%vdate%%==
+{{%%fname%%|Download %%fname%% (V-%%version%%)}}
 ===== Definitionen =====
@@ Line 25: / Line 39: @@
 > Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]].
 <code vb>Ich vergleiche mal die 2 folgenden Arrays miteinander
-print_rm array(1,2,2,array(4,5)), array(2,1,array(5,4),2)
+print_rm array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2)
 <Variant()>  (
-    [0] => <Integer> 1
+    [0] => <String> 1
-    [1] => <Integer> 2
+    [1] => <String> 2
-    [2] => <Integer> 2
+    [2] => <String> 2
     [3] => <Variant()>  (
-        [0] => <Integer> 4
+        [0] => <String> 4
-        [1] => <Integer> 5
+        [1] => <String> 5
     )
 )
@@ Line 39: / Line 53: @@
     [1] => <Integer> 1
     [2] => <Variant()>  (
-        [0] => <Integer> 5
+        [0] => <Double> 5
-        [1] => <Integer> 4
+        [1] => <Double> 4
     )
     [3] => <Integer> 2
 )
-'Normalverlgeich. Es wird Index und Value verglichen
+'Normalverlgeich. Es wird Index und Value verglichen. Das ganze ohne Typenvergleich
-? compaire(array(1,2,2,array(4,5)), array(2,1,array(5,4),2))
+? compaire(array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2))
 False
-'Nur ValueVergleich
+'Nur ValueVergleich, immer noch ohne Typenvergleich
-? compaire(array(1,2,2,array(4,5)), array(2,1,array(5,4),2),cpArrayValuesOnly)
+? compaire(array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2),cpArrayValuesOnly)
 True
+'Und jetzt mit Mit Typenvergleich
+? compaire(array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2), cpArrayValuesOnly+cpVarTypeStrong)
+False
 </code>
@@ Line 84: / Line 99: @@
 ===== Code =====
-<code vb udf_compaire.bas>Attribute VB_Name = "udf_compaire"
+<source '%%fpath%%/%%fname%%' vb>
-'-------------------------------------------------------------------------------
-'File         : udf_compaire.bas
-'               Copyright mpl by ERB software
-'               All rights reserved
-'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/compaire
-'Environment  : VBA 2010 +
-'Version      : 1.0.0
-'Name         : compaire
-'Author       : Stefan Erb (ERS)
-'History      : 12.09.2014 - ERS - Creation
-'-------------------------------------------------------------------------------
-Option Explicit
-Public Enum cpComapireParams
-    cpNone = 0
-    cpVarTypeStrong = 2 ^ 0     'Datentype aus varType() muss ebenfalls übereinstimmen
-    cpInstanceCompaire = 2 ^ 1    'Objekte nur auf Referenz prüfen. Gilt vor allem für Dictionaries
-End Enum
-'/**
-' * Vergleicht 2 Variaben
-' * @param  Variant
-' * @param  Variant
-' * @return Boolean
-' */
-Public Function compaire(ByRef iVar1 As Variant, ByRef iVar2 As Variant, Optional ByVal iParams As cpComapireParams = cpNone) As Boolean
-    'Typenvergleich bei Parameter cpVarTypeStrong durchführen
-    If iParams And cpVarTypeStrong Then If Not (VarType(iVar1) = VarType(iVar2)) Then Exit Function
-    'Null Vergleich
-    If IsNull(iVar1) Or IsNull(iVar2) Then
-        compaire = IsNull(cast(vbNull, iVar1)) And IsNull(cast(vbNull, iVar2))
-    'in Array vergleichen
-    ElseIf IsArray(iVar1) And IsArray(iVar2) Then
-        compaire = LBound(iVar1) = LBound(iVar2) And UBound(iVar1) = UBound(iVar2)
-        If compaire Then
-            Dim i As Integer: For i = LBound(iVar1) To UBound(iVar1)
-                compaire = compaire(iVar1(i), iVar2(i), iParams)
-                If Not compaire Then Exit Function
-            Next i
-        End If
-    'in Array suchen
-    'Objekt-Vergleich
-    ElseIf IsObject(iVar1) And IsObject(iVar2) Then
-        'Dictionary kann über den Key verglichen werden
-        If TypeName(iVar1) = "Dictionary" And TypeName(iVar2) = "Dictionary" And Not CBool(iParams And cpInstanceCompaire) Then
-            If iVar1.count = iVar2.count Then
-                Dim keys As Variant: keys = iVar1.keys
-                Dim k As Integer: For k = 0 To iVar1.count - 1
-                    If Not iVar2.exists(keys(k)) Then Exit Function
-                    If Not compaire(iVar1(keys(k)), iVar2(keys(k)), iParams) Then Exit Function
-                Next k
-                compaire = True
-            End If
-        'Objekte auf Referenz prüfen
-        Else
-            compaire = (iVar1 Is iVar2)
-        End If
-    'Value-Vergleich
-    ElseIf Not IsObject(iVar1) And Not IsObject(iVar2) And Not IsArray(iVar1) And Not IsArray(iVar2) Then
-        compaire = (iVar1 = cast(VarType(iVar1), iVar2))
-    End If
-End Function
-'/**
-' * Wandelt einen String wenn möglich in das angegebene Format um
-' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cast
-' * V1.0.0
-' * @param  VbVarType
-' * @param  Variant
-' * @param  Boolean     : Bei True wird ein Fehler greworfen, wenn der cast1() nichtr durchfürbar ist. Ansonsten wir der Eingabewert zurückgegeben
-' * @return Variant
-' */
-Private Function cast(ByVal iType As VbVarType, ByVal iVar As Variant, Optional ByVal iStrong As Boolean = False) As Variant
-On Error GoTo Err_Handler
-    cast = iVar
-    Select Case iType
-        Case vbNull, vbEmpty
-                            If Not (iVar = Empty Or IsNull(iVar)) Then Err.Raise 13         'Type mismatch
-                            cast = Choose(iType + 1, Empty, Null)
-        Case vbArray:       cast = IIf(IsArray(iVar), iVar, Array(iVar))
-        Case vbDate:        cast = CDate(iVar)
-        Case vbInteger:     cast = CInt(iVar)
-        Case vbLong:        cast = CLng(iVar)
-        Case vbDouble:      cast = CDbl(iVar)
-        Case vbDecimal:     cast = CDec(iVar)
-        Case vbByte:        cast = CByte(iVar)
-        Case vbSingle:      cast = CSng(iVar)
-        Case vbCurrency:    cast = CCur(iVar)
-        Case Else:          cast = CVar(iVar)
-    End Select
-Exit_Hanlder:
-    Exit Function
-Err_Handler:
-    If iStrong Then Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
-    cast = iVar
-End Function</code>

Yaslaw.Info

User Tools

Site Tools

Differences

Page Tools