Differences

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

--- vba:functions:compaire [15.09.2014 14:30:36]
yaslaw created
+++ 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 auf 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 =====
 ===== Beispiele =====
+==== Einfache Werte vergleichen ====
 <code vb>'Ein einfacher Vergleich 2er Werte
 ? compaire(1234, 1234.00)
 True
-Dasselbe mit Typenprüfung. Der Erste Parameter ist ein Integer, der Zweite ein Double
+'Dasselbe mit Typenprüfung. Der Erste Parameter ist ein Integer, der Zweite ein Double
 ? compaire(1234, 1234.00, cpVarTypeStrong)
 False
@@ Line 19: / Line 35: @@
 ? compaire(Null, 0, cpVarTypeStrong)
 False</code>
-Für die folgenden Vergleich mit Dictionaries verwende ich die Funktion [[vba:cast:cdict]] um die Dictionaries zu erstellen
+==== Arrays vergleichen ====
+> 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.0,4.0),2)
+<Variant()>  (
+    [0] => <String> 1
+    [1] => <String> 2
+    [2] => <String> 2
+    [3] => <Variant()>  (
+        [0] => <String> 4
+        [1] => <String> 5
+    )
+)
+<Variant()>  (
+    [0] => <Integer> 2
+    [1] => <Integer> 1
+    [2] => <Variant()>  (
+        [0] => <Double> 5
+        [1] => <Double> 4
+    )
+    [3] => <Integer> 2
+)
+'Normalverlgeich. Es wird Index und Value verglichen. Das ganze ohne Typenvergleich
+? compaire(array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2))
+False
+'Nur ValueVergleich, immer noch ohne Typenvergleich
+? 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>
+==== Dictionaries vergleichen ====
+> Für die folgenden Vergleich mit Dictionaries verwende ich die Funktion [[vba:cast:cdict]] um die Dictionaries zu erstellen
+> Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]].
 <code vb>'Die Arrays:
 print_rm cDict("A", 1, "B", 2.0) , cDict("B", 2, "A", 1)
@@ Line 44: / 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