This shows you the differences between two versions of the page.
Both sides previous revision Previous revision Next revision | Previous revision | ||
vba:functions:compaire [16.09.2014 11:17:32] yaslaw [Arrays 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() ====== | ====== [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. | Arrays untereinander, Dictionaries, Null mit Empty etc. | ||
+ | // | ||
+ | ==Version %%version%% %%vdate%%== | ||
+ | |||
+ | {{%%fname%%|Download %%fname%% (V-%%version%%)}} | ||
===== Definitionen ===== | ===== Definitionen ===== | ||
Line 25: | Line 39: | ||
> Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]]. | > Für die Ausgabe der Resultate verwendete ich die Funktion [[:vba:functions:print_r:]]. | ||
<code vb>Ich vergleiche mal die 2 folgenden Arrays miteinander | <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()> ( | <Variant()> ( | ||
[0] => <String> 1 | [0] => <String> 1 | ||
Line 31: | Line 45: | ||
[2] => <String> 2 | [2] => <String> 2 | ||
[3] => <Variant()> ( | [3] => <Variant()> ( | ||
- | [0] => <Integer> 4 | + | [0] => <String> 4 |
- | [1] => <Integer> 5 | + | [1] => <String> 5 |
) | ) | ||
) | ) | ||
Line 39: | Line 53: | ||
[1] => <Integer> 1 | [1] => <Integer> 1 | ||
[2] => <Variant()> ( | [2] => <Variant()> ( | ||
- | [0] => <Integer> 5 | + | [0] => <Double> 5 |
- | [1] => <Integer> 4 | + | [1] => <Double> 4 |
) | ) | ||
[3] => <Integer> 2 | [3] => <Integer> 2 | ||
Line 46: | Line 60: | ||
'Normalverlgeich. Es wird Index und Value verglichen. Das ganze ohne Typenvergleich | '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 | False | ||
'Nur ValueVergleich, immer noch ohne Typenvergleich | '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 | True | ||
'Und jetzt mit Mit Typenvergleich | 'Und jetzt mit Mit Typenvergleich | ||
- | ? compaire(array("1","2","2",array(4,5)), array(2,1,array(5,4),2), cpArrayValuesOnly+cpVarTypeStrong) | + | ? compaire(array("1","2","2",array("4","5")), array(2,1,array(5.0,4.0),2), cpArrayValuesOnly+cpVarTypeStrong) |
False | False | ||
</code> | </code> | ||
Line 85: | Line 99: | ||
===== Code ===== | ===== 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> | + |