| Home |
| Search |
| Today's Posts |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| IF/Then Theory between two or more tabs. | Excel Worksheet Functions | |||
| theory of biorhythms | Excel Discussion (Misc queries) | |||
| Excel 2003 does not calculate automation add-in functions automati | Excel Programming | |||
| Suddenly cannot calculate functions or formulas in Excel | Excel Worksheet Functions | |||
| In theory Excel vba work out a roster by itself | Excel Programming | |||
Threaded Mode
