how to calculate set theory in excel functions
On 14 מרץ, 15:58, Chip Pearson wrote:
Of what do you want to find the intersection and union? Ranges?
Arrays? Below are two functions, Intersect and Union that work with
arrays. A third function, IsArrayAllocated, is used to test whether an
array is allocated and contains data. Both Intersect and Union use the
IsArrayAllocated function.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Function Intersect(A() As Variant, B() As Variant) As Variant
Dim NdxA As Long
Dim NdxB As Long
Dim NdxR As Long
Dim N As Long
Dim R() As Variant
Dim Found As Boolean
If IsArrayAllocated(A) = False Then
* * Exit Function
End If
If IsArrayAllocated(B) = False Then
* * Exit Function
End If
N = Application.Max(UBound(A) - LBound(A) + 1, _
* * * * * * * * * * UBound(B) - LBound(B) + 1)
ReDim R(1 To N)
For NdxA = LBound(A) To UBound(A)
* * For NdxB = LBound(B) To UBound(B)
* * * * If A(NdxA) = B(NdxB) Then
* * * * * * Found = False
* * * * * * For N = LBound(R) To UBound(R)
* * * * * * * * If R(N) = A(NdxA) Then
* * * * * * * * * * Found = True
* * * * * * * * * * Exit For
* * * * * * * * End If
* * * * * * Next N
* * * * * * If Found = False Then
* * * * * * * * NdxR = NdxR + 1
* * * * * * * * R(NdxR) = A(NdxA)
* * * * * * End If
* * * * End If
* * Next NdxB
Next NdxA
If NdxR 0 Then
* * ReDim Preserve R(1 To NdxR)
* * Intersect = R
End If
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Function Union(A() As Variant, B() As Variant) As Variant
Dim NdxA As Long
Dim NdxB As Long
Dim NdxR As Long
Dim N As Long
Dim R() As Variant
Dim Found As Boolean
If IsArrayAllocated(A) = False Then
* * Exit Function
End If
If IsArrayAllocated(B) = False Then
* * Exit Function
End If
N = UBound(A) - LBound(A) + 1 + UBound(B) - LBound(B) + 1
ReDim R(1 To N)
For NdxA = LBound(A) To UBound(A)
* * Found = False
* * For N = LBound(R) To UBound(R)
* * * * If R(N) = A(NdxA) Then
* * * * * * Found = True
* * * * * * Exit For
* * * * End If
* * Next N
* * If Found = False Then
* * * * NdxR = NdxR + 1
* * * * R(NdxR) = A(NdxA)
* * End If
Next NdxA
For NdxB = LBound(B) To UBound(B)
* * Found = False
* * For N = LBound(R) To UBound(R)
* * * * If R(N) = B(NdxB) Then
* * * * * * Found = True
* * * * * * Exit For
* * * * End If
* * Next N
* * If Found = False Then
* * * * NdxR = NdxR + 1
* * * * R(NdxR) = B(NdxB)
* * End If
Next NdxB
If NdxR 0 Then
* * ReDim Preserve R(1 To NdxR)
* * Union = R
End If
End Function
Function IsArrayAllocated(A As Variant) As Boolean
* * On Error Resume Next
* * IsArrayAllocated = IsArray(A) = True And _
* * * * * * * * * * Not IsError(LBound(A, 1)) And _
* * * * * * * * * * LBound(A, 1) <= UBound(A, 1)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
You can then call these functions, passing arrays of data. For
example, the following code creates two array, A and B, populates
those arrays with data, and then gets the Intersection and Union of
the arrays.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Sub AAA()
* * Dim A(1 To 3)
* * Dim B(1 To 3)
* * Dim R As Variant
* * Dim N As Long
* * A(1) = 1
* * A(2) = 2
* * A(3) = 3
* * B(1) = 11
* * B(2) = 2
* * B(3) = 33
* * Debug.Print "============== INTERSECT"
* * R = Intersect(A, B)
* * If IsArrayAllocated(R) = True Then
* * * * For N = LBound(R) To UBound(R)
* * * * * * Debug.Print R(N)
* * * * Next N
* * Else
* * * * Debug.Print "No Intersection"
* * End If
* * Debug.Print "=============="
* * Erase R
* * Debug.Print "============== UNION"
* * R = Union(A, B)
* * If IsArrayAllocated(R) = True Then
* * * * For N = LBound(R) To UBound(R)
* * * * * * Debug.Print R(N)
* * * * Next N
* * Else
* * * * Debug.Print "No Union"
* * End If
* * Debug.Print "=============="
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
* * Excel Product Group, 1998 - 2009
Pearson Software Consulting, LLCwww.cpearson.com
(email on web site)
On Sat, 14 Mar 2009 04:02:42 -0700 (PDT), thread
wrote:
Hi
i'm trying to find a way to calculate union and Intersection,
i know its posible in VBA but i''m trying to find a way to do it in
the excel functions
any ideas?-הסתר טקסט מצוטט-
-הראה טקסט מצוטט-
thank you for the replay,the issue is that i prefer not to use the VBA
code but the common functions of the excel
|