Option Explicit Sub testUnionAndIntersection() 'Intersection And Union 'Also called 'Logical disjunction Logical conjunction 'AND OR Dim a As New Scripting.Dictionary Dim b As New Scripting.Dictionary Dim keysA As Variant Dim keysB As Variant Dim keysC As Variant Dim keysD As Variant a.Add "A", "" a.Add "B", "" a.Add "C", "" b.Add "A", "" b.Add "C", "" b.Add "X", "" keysA = a.Keys keysB = b.Keys keysC = getIntersectionSet(keysA, keysB) Debug.Print Join(keysC, ",") 'A,C keysD = getUnionSet(keysA, keysB) Debug.Print Join(keysD, ",") 'A,B,C,X Call DeleteElementAt(1, keysB) Debug.Print Join(keysB, ",") 'A,X End Sub Function getIntersectionSet(arr1 As Variant, arr2 As Variant) As Variant Dim vntTmp As Variant Dim vntRst As Variant If Not (IsArray(arr1) And IsArray(arr2)) Then Exit Function End If For Each vntTmp In arr1 If IsInArray(CStr(vntTmp), arr2) Then push vntTmp, vntRst End If Next getIntersectionSet = vntRst End Function Function getUnionSet(arr1 As Variant, arr2 As Variant) As Variant Dim vntTmp As Variant Dim vntRst As Variant If Not (IsArray(arr1) And IsArray(arr2)) Then Exit Function End If vntRst = arr1 For Each vntTmp In arr2 If Not IsInArray(CStr(vntTmp), vntRst) Then push vntTmp, vntRst End If Next getUnionSet = vntRst End Function Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function Public Sub DeleteElementAt(ByVal index As Integer, ByRef prLst As Variant) Dim i As Integer For i = index + 1 To UBound(prLst) prLst(i - 1) = prLst(i) Next ReDim Preserve prLst(UBound(prLst) - 1) End Sub Public Function push(ByVal val As Variant, ByRef arr As Variant, Optional ByVal unique As Boolean = False) As Integer Dim lngX As Long If unique Then If Not IsEmpty(arr) Then If IsArray(arr) Then For lngX = LBound(arr) To UBound(arr) If arr(lngX) = val Then push = UBound(arr) Exit Function End If Next End If End If End If If IsArray(arr) Then On Error GoTo initArray ReDim Preserve arr(UBound(arr) + 1) Else initArray: ReDim arr(0) End If If VarType(val) = 9 Then '9 is object Set arr(UBound(arr)) = val Else arr(UBound(arr)) = val End If push = UBound(arr) End Function
2017年2月15日水曜日
VBA Arrayの論理計算、交集、並集(AND OR)(Intersection And Union)(Logical disjunction Logical conjunction)
登録:
投稿 (Atom)