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)