Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
I need a Boolean function that, given two input arrays of equal size, will
return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
This should do it. The only way that I know of is a brute force attack.
Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
Oops that does not quite work... Try this one...
Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary3, ary1) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry1 For lngAry2 = LBound(ary2) To UBound(ary2) For lngAry1 = LBound(ary1) To UBound(ary1) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry1 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry2 End Function -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should do it. The only way that I know of is a brute force attack. Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
I get False with this set up...
Dim Arr1(4 To 7) As Long Dim Arr2(7 To 10) As Long Arr1(4) = 4 Arr1(5) = 2 Arr1(6) = 3 Arr1(7) = 1 Arr2(7) = 1 Arr2(8) = 2 Arr2(9) = 4 Arr2(10) = 3 Rick "Jim Thomlinson" wrote in message ... Oops that does not quite work... Try this one... Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary3, ary1) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry1 For lngAry2 = LBound(ary2) To UBound(ary2) For lngAry1 = LBound(ary1) To UBound(ary1) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry1 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry2 End Function -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should do it. The only way that I know of is a brute force attack. Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
Changing this line...
If UBound(ary1) < UBound(ary2) Then to this line... If UBound(ary1) - LBound(ary1) < UBound(ary2) - LBound(ary2) Then appears to correct the problem. Rick "Rick Rothstein (MVP - VB)" wrote in message ... I get False with this set up... Dim Arr1(4 To 7) As Long Dim Arr2(7 To 10) As Long Arr1(4) = 4 Arr1(5) = 2 Arr1(6) = 3 Arr1(7) = 1 Arr2(7) = 1 Arr2(8) = 2 Arr2(9) = 4 Arr2(10) = 3 Rick "Jim Thomlinson" wrote in message ... Oops that does not quite work... Try this one... Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary3, ary1) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry1 For lngAry2 = LBound(ary2) To UBound(ary2) For lngAry1 = LBound(ary1) To UBound(ary1) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry1 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry2 End Function -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should do it. The only way that I know of is a brute force attack. Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
Thanks Jim......it looks great!
-- Gary''s Student - gsnu200792 "Jim Thomlinson" wrote: Oops that does not quite work... Try this one... Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary3, ary1) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry1 For lngAry2 = LBound(ary2) To UBound(ary2) For lngAry1 = LBound(ary1) To UBound(ary1) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry1 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry2 End Function -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should do it. The only way that I know of is a brute force attack. Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
I think I spotted a flaw in Jim's method. Try this subroutine with Jim's
function (I get it to return True even though the two arrays are clearly different)... Sub Test() Dim Arr1(0 To 3) As Variant Dim Arr2(0 To 3) As Variant ' First Array Arr1(0) = 4 Arr1(1) = 4 Arr1(2) = 3 Arr1(3) = 1 ' Second Array Arr2(0) = 1 Arr2(1) = 3 Arr2(2) = 4 Arr2(3) = 3 Debug.Print ArrayCompare(Arr1, Arr2) End Sub Rick "Gary''s Student" wrote in message ... Thanks Jim......it looks great! -- Gary''s Student - gsnu200792 "Jim Thomlinson" wrote: Oops that does not quite work... Try this one... Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary3, ary1) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry1 For lngAry2 = LBound(ary2) To UBound(ary2) For lngAry1 = LBound(ary1) To UBound(ary1) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry1 If blnFound = False Then ArrayCompare = False Exit Function End If blnFound = False Next lngAry2 End Function -- HTH... Jim Thomlinson "Jim Thomlinson" wrote: This should do it. The only way that I know of is a brute force attack. Sub Test() Dim ary1 As Variant Dim ary2 As Variant Dim ary3 As Variant Dim ary4 As Variant ary1 = Array(1, 2, 3, 4, 5, 6) ary2 = Array(1, 6, 4, 3, 5, 2) ary3 = Array(1, 1, 4, 3, 5, 2) ary4 = Array(1, 2, 3, 4, 5, 6, 7) MsgBox ArrayCompare(ary1, ary2) MsgBox ArrayCompare(ary1, ary3) MsgBox ArrayCompare(ary2, ary4) End Sub Public Function ArrayCompare(ByRef ary1 As Variant, ByRef ary2 As Variant) As Boolean Dim lngAry1 As Long Dim lngAry2 As Long Dim blnFound As Boolean ArrayCompare = True If UBound(ary1) < UBound(ary2) Then ArrayCompare = False Exit Function End If blnFound = False For lngAry1 = LBound(ary1) To UBound(ary1) For lngAry2 = LBound(ary2) To UBound(ary2) If ary1(lngAry1) = ary2(lngAry2) Then blnFound = True Exit For End If Next lngAry2 If blnFound = False Then ArrayCompare = False Exit For End If blnFound = False Next lngAry1 End Function -- HTH... Jim Thomlinson "Gary''s Student" wrote: I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
This was a good problem! I'm almost completely sure<g that this function
works correctly (with text or numeric arrays or Variant arrays containing text or numeric values)... Function IsSameContent(ByVal Arr1 As Variant, _ ByVal Arr2 As Variant) As Boolean Dim X As Long Dim Count() As Long Dim ArrayString As String If (VarType(Arr1) < vbArray) Or (VarType(Arr2) < vbArray) Or _ (UBound(Arr1) - LBound(Arr1) < UBound(Arr2) - LBound(Arr2)) Then Exit Function End If ReDim Count(0 To UBound(Arr1) - LBound(Arr1)) ArrayString = Chr$(1) For X = LBound(Arr1) To UBound(Arr1) ArrayString = CStr(ArrayString) & Arr1(X) & Chr$(1) Next IsSameContent = True For X = LBound(Arr2) To UBound(Arr2) If InStr(ArrayString, Chr$(1) & Arr2(X) & Chr$(1)) = 0 Then IsSameContent = False Exit Function Else ArrayString = Replace(ArrayString, Arr2(X), "", , 1) End If Next End Function Rick "Gary''s Student" wrote in message ... I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
Thanks...I was sorting the arrays and then comparing them item-by-item.
Both your code and Jim's were mush faster than mine. -- Gary''s Student - gsnu200792 "Rick Rothstein (MVP - VB)" wrote: This was a good problem! I'm almost completely sure<g that this function works correctly (with text or numeric arrays or Variant arrays containing text or numeric values)... Function IsSameContent(ByVal Arr1 As Variant, _ ByVal Arr2 As Variant) As Boolean Dim X As Long Dim Count() As Long Dim ArrayString As String If (VarType(Arr1) < vbArray) Or (VarType(Arr2) < vbArray) Or _ (UBound(Arr1) - LBound(Arr1) < UBound(Arr2) - LBound(Arr2)) Then Exit Function End If ReDim Count(0 To UBound(Arr1) - LBound(Arr1)) ArrayString = Chr$(1) For X = LBound(Arr1) To UBound(Arr1) ArrayString = CStr(ArrayString) & Arr1(X) & Chr$(1) Next IsSameContent = True For X = LBound(Arr2) To UBound(Arr2) If InStr(ArrayString, Chr$(1) & Arr2(X) & Chr$(1)) = 0 Then IsSameContent = False Exit Function Else ArrayString = Replace(ArrayString, Arr2(X), "", , 1) End If Next End Function Rick "Gary''s Student" wrote in message ... I need a Boolean function that, given two input arrays of equal size, will return TRUE if the contents of the arrays are the same (apart from order), otherwise FALSE. For example, if array 1 contained: 1,2,3,4 and array 2 contained: 2,3,1,4 then the function should return TRUE If array 1 contained: 1,1,6,7 and array 2 contained: 7,1,6,2 then the function should return FALSE. -- Gary''s Student - gsnu2007xx |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
On Mon, 16 Jun 2008 16:01:51 -0400, "Rick Rothstein \(MVP - VB\)"
wrote: This was a good problem! I'm almost completely sure<g that this function works correctly (with text or numeric arrays or Variant arrays containing text or numeric values)... Function IsSameContent(ByVal Arr1 As Variant, _ ByVal Arr2 As Variant) As Boolean Dim X As Long Dim Count() As Long Dim ArrayString As String If (VarType(Arr1) < vbArray) Or (VarType(Arr2) < vbArray) Or _ (UBound(Arr1) - LBound(Arr1) < UBound(Arr2) - LBound(Arr2)) Then Exit Function End If ReDim Count(0 To UBound(Arr1) - LBound(Arr1)) ArrayString = Chr$(1) For X = LBound(Arr1) To UBound(Arr1) ArrayString = CStr(ArrayString) & Arr1(X) & Chr$(1) Next IsSameContent = True For X = LBound(Arr2) To UBound(Arr2) If InStr(ArrayString, Chr$(1) & Arr2(X) & Chr$(1)) = 0 Then IsSameContent = False Exit Function Else ArrayString = Replace(ArrayString, Arr2(X), "", , 1) End If Next End Function Rick Rick, I've been fooling around with this, and with my own version which sorts the array and then compares item for item. And I ran into an issue (XL2007) whereby if the arguments for the function is a range reference, rather than an array constant, then the function fails. In particular, it fails when trying to use the Ubound method, since the argument is an object. This is true even when passing the argument ByVal. I worked around this by testing to see if the argument was an object or not, and using the Count property if it was an object, but I wonder if there is a more efficient method. Any thoughts? (I did not bother to test, as you did, to make sure that the references passed were arrays -- being OK with the #VALUE! error being returned in that instance). Also, whether the argument being passed was an array constant, or a range reference, the vartype was 8204. Here's my effort. I used a simple Bubblesort routine, although I know there are faster algorithms. ======================================= Function CompArr(ByVal Array1, ByVal Array2) As Boolean Dim a1 As Variant, a2 As Variant a1 = Extract(Array1) a2 = Extract(Array2) CompArr = True If UBound(a1) < UBound(a2) Then CompArr = False Exit Function End If BubbleSort a1 BubbleSort a2 For i = 1 To UBound(a1) If a1(i) < a2(i) Then CompArr = False Exit Function End If Next i End Function Private Sub BubbleSort(TempArray As Variant) Dim temp As Variant Dim i As Integer Dim NoExchanges As Integer ' Loop until no more "exchanges" are made. Do NoExchanges = True ' Loop through each element in the array. For i = 1 To UBound(TempArray) - 1 ' If the element is greater than the element ' following it, exchange the two elements. If TempArray(i) TempArray(i + 1) Then NoExchanges = False temp = TempArray(i) TempArray(i) = TempArray(i + 1) TempArray(i + 1) = temp End If Next i Loop While Not (NoExchanges) End Sub Private Function Extract(a) As Variant Dim o As Object Dim i As Long Dim temp() As Variant If IsObject(a) Then ReDim temp(1 To a.Count) For i = 1 To a.Count temp(i) = a(i) Next i Else ReDim temp(1 To UBound(a)) For i = 1 To UBound(a) temp(i) = a(i) Next i End If Extract = temp End Function ================================== --ron |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
On Tue, 17 Jun 2008 07:18:28 -0400, Ron Rosenfeld
wrote: I worked around this by testing to see if the argument was an object or not, and using the Count property if it was an object, but I wonder if there is a more efficient method. Actually, the Extract function can be simplified: ======================= Private Function Extract(a) As Variant Dim i As Long Dim temp() As Variant If IsObject(a) Then ReDim temp(1 To a.Count) For i = 1 To a.Count temp(i) = a(i) Next i Extract = temp Else Extract = a End If End Function ========================= --ron |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
This is very interesting!!
I guess the reason I did not hit a problem was that I did the sorts in-line rather than thru another function call. In any case, I like your bi-directional cross-check much better. Thanks again!! -- Gary''s Student - gsnu200792 "Ron Rosenfeld" wrote: On Mon, 16 Jun 2008 16:01:51 -0400, "Rick Rothstein \(MVP - VB\)" wrote: This was a good problem! I'm almost completely sure<g that this function works correctly (with text or numeric arrays or Variant arrays containing text or numeric values)... Function IsSameContent(ByVal Arr1 As Variant, _ ByVal Arr2 As Variant) As Boolean Dim X As Long Dim Count() As Long Dim ArrayString As String If (VarType(Arr1) < vbArray) Or (VarType(Arr2) < vbArray) Or _ (UBound(Arr1) - LBound(Arr1) < UBound(Arr2) - LBound(Arr2)) Then Exit Function End If ReDim Count(0 To UBound(Arr1) - LBound(Arr1)) ArrayString = Chr$(1) For X = LBound(Arr1) To UBound(Arr1) ArrayString = CStr(ArrayString) & Arr1(X) & Chr$(1) Next IsSameContent = True For X = LBound(Arr2) To UBound(Arr2) If InStr(ArrayString, Chr$(1) & Arr2(X) & Chr$(1)) = 0 Then IsSameContent = False Exit Function Else ArrayString = Replace(ArrayString, Arr2(X), "", , 1) End If Next End Function Rick Rick, I've been fooling around with this, and with my own version which sorts the array and then compares item for item. And I ran into an issue (XL2007) whereby if the arguments for the function is a range reference, rather than an array constant, then the function fails. In particular, it fails when trying to use the Ubound method, since the argument is an object. This is true even when passing the argument ByVal. I worked around this by testing to see if the argument was an object or not, and using the Count property if it was an object, but I wonder if there is a more efficient method. Any thoughts? (I did not bother to test, as you did, to make sure that the references passed were arrays -- being OK with the #VALUE! error being returned in that instance). Also, whether the argument being passed was an array constant, or a range reference, the vartype was 8204. Here's my effort. I used a simple Bubblesort routine, although I know there are faster algorithms. ======================================= Function CompArr(ByVal Array1, ByVal Array2) As Boolean Dim a1 As Variant, a2 As Variant a1 = Extract(Array1) a2 = Extract(Array2) CompArr = True If UBound(a1) < UBound(a2) Then CompArr = False Exit Function End If BubbleSort a1 BubbleSort a2 For i = 1 To UBound(a1) If a1(i) < a2(i) Then CompArr = False Exit Function End If Next i End Function Private Sub BubbleSort(TempArray As Variant) Dim temp As Variant Dim i As Integer Dim NoExchanges As Integer ' Loop until no more "exchanges" are made. Do NoExchanges = True ' Loop through each element in the array. For i = 1 To UBound(TempArray) - 1 ' If the element is greater than the element ' following it, exchange the two elements. If TempArray(i) TempArray(i + 1) Then NoExchanges = False temp = TempArray(i) TempArray(i) = TempArray(i + 1) TempArray(i + 1) = temp End If Next i Loop While Not (NoExchanges) End Sub Private Function Extract(a) As Variant Dim o As Object Dim i As Long Dim temp() As Variant If IsObject(a) Then ReDim temp(1 To a.Count) For i = 1 To a.Count temp(i) = a(i) Next i Else ReDim temp(1 To UBound(a)) For i = 1 To UBound(a) temp(i) = a(i) Next i End If Extract = temp End Function ================================== --ron |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Same Contents, Regardless of Order
On Tue, 17 Jun 2008 10:16:02 -0700, Gary''s Student
wrote: This is very interesting!! I guess the reason I did not hit a problem was that I did the sorts in-line rather than thru another function call. In any case, I like your bi-directional cross-check much better. Thanks again!! -- Gary''s Student - gsnu200792 Gary''s Student, I'm not sure if you are responding to me or to Rick. But if to me, how is the speed of my routine on your data compared with the others? Is it worthwhile coding a faster sort routine? Thanks. --ron --ron |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to change series plotting order without changing legend order? | Charts and Charting in Excel | |||
How stop Excel file UK date order changing to US order in m.merge | Excel Discussion (Misc queries) | |||
arrange contents of a table in Alphabetical order in excelsheet | Excel Worksheet Functions | |||
Daily Macro to Download Data, Order and paste in order | Excel Worksheet Functions | |||
Randomize the order of the contents of an array | Excel Programming |