Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 72
Default how to calculate set theory in excel functions

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?
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 7,247
Default how to calculate set theory in excel functions

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, LLC
www.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?

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 72
Default 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
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
IF/Then Theory between two or more tabs. ruaduck Excel Worksheet Functions 3 May 28th 08 10:38 PM
theory of biorhythms deadman Excel Discussion (Misc queries) 2 May 27th 06 01:17 PM
Excel 2003 does not calculate automation add-in functions automati wschaub Excel Programming 1 July 15th 05 04:30 PM
Suddenly cannot calculate functions or formulas in Excel Leon Hairie Excel Worksheet Functions 1 March 1st 05 04:26 PM
In theory Excel vba work out a roster by itself Max Bialystock Excel Programming 3 February 6th 04 03:23 PM


All times are GMT +1. The time now is 06:48 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright 2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"