how to calculate set theory in excel functions

  • Thread starter Thread starter thread
  • Start date Start date
T

thread

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?
 
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)
 
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 _
                    NotIsError(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)




-הר××” טקסט מצוטט-

thank you for the replay,the issue is that i prefer not to use the VBA
code but the common functions of the excel
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top