Pessoal, obrigado pelas respostas.
Vocês tinham razão, existiam funções sendo chamadas que não faziam parte do código.
Eu consegui o código completo, ele constrói 4 funções relacionadas a Matrizes. A que me interessava era justamente essa, de achar a diferença entre as matrizes, porém quando eu executo ela, ela não se propõe a fazer oque fala, somente retorna o primeiro valor. Vou colar o código aqui caso vocês queiram testar. Para que as fórmulas funcionem, é só colar ele inteiro no VBA
Option Explicit
Public Sub AddArrayElement( _
ByRef SourceArray As Variant, _
Optional ByVal NewValue As Variant, _
Optional ByVal AddNewValueAsArray As Boolean, _
Optional ByVal Base As Long = 0, _
Optional ByVal Increment As Long = 1, _
Optional ByRef Count As Variant _
)
' Add an element, multiple elements, or an array to the end of the array.
'
' Syntax
'
' AddArrayElement(SourceArray, [NewValue], [AddNewValueAsArray], [Base], [Increment], [Count])
'
' SourceArray - The source array to which the value is to be added.
'
' NewValue - The value or values to add to the array. If an array is passed and
' AddNewValueAsArray is False or omitted then each value in the array is
' added as an individual array element. If AddNewValueAsArray is True then
' the value is added as a single array. Optional. If omitted then the
' parameter SourceArray is converted into an array if not already an array.
'
' AddNewValueAsArray - If True then the new value is added as an
' array. If False then the new value or values are added as inividual
' array elements. Optional. If omitted then False is assumed.
'
' Base - The base at which a new array is started. Optional. If omitted then
' the base is assumed to be 0.
'
' Increment - The number of extra elements to add to the source array if it
' needs to be extended. Optional. If omitted then it is assumed to be 1.
'
' Count - The count of used elements in the array. Incremented by the number of
' values added to the array so that the final value continues to represent
' the count of used elements. Optional.
Dim Index As Long
Dim Result As Long
Dim Value As Variant
If IsMissing(Count) Then
Increment = 1
Count = GetArrayElementCount(SourceArray)
End If
If Increment < 1 Then Increment = 1
' Add new elements to target array
If Not IsMissing(NewValue) Then
If IsArray(NewValue) And Not AddNewValueAsArray Then
For Index = LBound(NewValue) To UBound(NewValue)
AddArrayElement SourceArray, NewValue(Index), Base, Increment, Count
Next Index
Else
If Not IsArrayInitialized(SourceArray) Then
InsureArrayInitialized SourceArray, Base, Increment
Else
If GetArrayElementCount(SourceArray) <= Count Then
ReDim Preserve SourceArray(LBound(SourceArray) To UBound(SourceArray) + Increment)
End If
End If
SourceArray(LBound(SourceArray) + Count) = NewValue
Count = Count + 1
End If
Else
' Convert source to an array if not already an array
If (VarType(NewValue) And vbArray) = 0 Then
Value = SourceArray
ReDim SourceArray(Base To Base)
SourceArray(Base) = Value
End If
End If
End Sub
Public Function GetArrayDifference( _
ByVal SourceArray1 As Variant, _
ByVal SourceArray2 As Variant, _
Optional ByVal Sorted As Boolean _
) As Variant
' Return the difference of the two arrays containing only the uncommon
' elements. If there is no difference then Empty is returned. The lower bound
' of the first source array is used as the base for the new array. To speed up
' the routine pass in sorted arrays (use the SortArray function) and pass True
' for the parameter Sorted. The returned array is always sorted in ascending
' order.
'
' Syntax
'
' GetArrayDifference(SourceArray1, SourceArray2, [Sorted])
'
' SourceArray1 - Any single dimension array.
'
' SourceArray2 - Any single dimension array.
'
' Sorted - Pass True if both source arrays are sorted, False otherwise.
Dim Index1 As Long
Dim Index2 As Long
Dim Result As Variant
Dim Count As Long
Dim Value As Variant
If Not IsOneDimensionArray(SourceArray1) Then Stop ' source array must have one dimension
If Not IsOneDimensionArray(SourceArray2) Then Stop ' source array must have one dimension
If Not Sorted Then
SortArray SourceArray1
SortArray SourceArray2
End If
If GetArrayElementCount(SourceArray1) = 0 Then
GetArrayDifference = SourceArray2
Exit Function
End If
If GetArrayElementCount(SourceArray2) = 0 Then
GetArrayDifference = SourceArray1
Exit Function
End If
Index1 = LBound(SourceArray1)
Index2 = LBound(SourceArray2)
Do While Index1 <= UBound(SourceArray1) Or Index2 <= UBound(SourceArray2)
If Index1 <= UBound(SourceArray1) Then
If Index2 <= UBound(SourceArray2) Then
Do While SourceArray1(Index1) < SourceArray2(Index2) And Index1 <= UBound(SourceArray1)
AddArrayElement Result, SourceArray1(Index1), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Value = SourceArray1(Index1)
Do While SourceArray1(Index1) = Value
Index1 = Index1 + 1
If Index1 > UBound(SourceArray1) Then Exit Do
Loop
If Index1 > UBound(SourceArray1) Then Exit Do
Loop
Else
AddArrayElement Result, SourceArray1(Index1), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Value = SourceArray1(Index1)
Do While SourceArray1(Index1) = Value
Index1 = Index1 + 1
If Index1 > UBound(SourceArray1) Then Exit Do
Loop
End If
End If
If Index2 <= UBound(SourceArray2) Then
If Index1 <= UBound(SourceArray1) Then
Do While SourceArray1(Index1) > SourceArray2(Index2) And Index2 <= UBound(SourceArray2)
AddArrayElement Result, SourceArray2(Index2), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Value = SourceArray2(Index2)
Do While SourceArray2(Index2) = Value
Index2 = Index2 + 1
If Index2 > UBound(SourceArray2) Then Exit Do
Loop
If Index2 > UBound(SourceArray2) Then Exit Do
Loop
Else
AddArrayElement Result, SourceArray2(Index2), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Value = SourceArray2(Index2)
Do While SourceArray2(Index2) = Value
Index2 = Index2 + 1
If Index2 > UBound(SourceArray2) Then Exit Do
Loop
End If
End If
If Index1 <= UBound(SourceArray1) And Index2 <= UBound(SourceArray2) And Index1 <= UBound(SourceArray1) And Index2 <= UBound(SourceArray2) Then
Value = SourceArray1(Index1)
Do While SourceArray1(Index1) = Value
Index1 = Index1 + 1
If Index1 > UBound(SourceArray1) Then Exit Do
Loop
Do While SourceArray2(Index2) = Value
Index2 = Index2 + 1
If Index2 > UBound(SourceArray2) Then Exit Do
Loop
End If
Loop
If Count > 0 Then
TrimArray Result, Count
GetArrayDifference = Result
Else
GetArrayDifference = Array()
End If
End Function
Public Function GetArrayElementCount( _
ByVal SourceArray As Variant _
) As Long
' Return the number of array elements in a single dimension array.
'
' Syntax
'
' GetArrayElementCount(SourceArray)
'
' SourceArray - Any single dimension array.
If Not IsOneDimensionArray(SourceArray) Then Stop ' source array must be one dimension
If Not IsArrayInitialized(SourceArray) Then Exit Function
GetArrayElementCount = UBound(SourceArray) - LBound(SourceArray) + 1
End Function
Public Function GetArrayIntersection( _
ByVal SourceArray1 As Variant, _
ByVal SourceArray2 As Variant, _
Optional ByVal Sorted As Boolean _
) As Variant
' Return the intersection of the two arrays containing only the common
' elements. If there is no intersection then an Empty is returned. The lower
' bound of the first source array is used as the base for the new array. To
' speed up the routine pass in sorted arrays (using the SortArray function)
' and pass True for the parameter Sorted. The returned array is always sorted
' in ascending order.
'
' Syntax
'
' GetArrayIntersection(SourceArray1, SourceArray2, [Sorted])
'
' SourceArray1 - Any single dimension array.
'
' SourceArray2 - Any single dimension array.
'
' Sorted - Pass True if both source arrays are sorted, False otherwise.
Dim Index1 As Long
Dim Index2 As Long
Dim Result As Variant
Dim Count As Long
Dim Value As Variant
If Not IsOneDimensionArray(SourceArray1) Then Stop ' Invalid parameter
If Not IsOneDimensionArray(SourceArray2) Then Stop ' Invalid parameter
If GetArrayElementCount(SourceArray1) = 0 Then Exit Function
If GetArrayElementCount(SourceArray2) = 0 Then Exit Function
If Not Sorted Then
SortArray SourceArray1
SortArray SourceArray2
End If
Index1 = LBound(SourceArray1)
Index2 = LBound(SourceArray2)
Do
Do While SourceArray1(Index1) < SourceArray2(Index2) And Index1 < UBound(SourceArray1)
Index1 = Index1 + 1
Loop
Do While SourceArray1(Index1) > SourceArray2(Index2) And Index2 < UBound(SourceArray2)
Index2 = Index2 + 1
Loop
If SourceArray1(Index1) = SourceArray2(Index2) Then
AddArrayElement Result, SourceArray1(Index1), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Value = SourceArray1(Index1)
Do While SourceArray1(Index1) = Value
Index1 = Index1 + 1
If Index1 > UBound(SourceArray1) Then Exit Do
Loop
Do While SourceArray2(Index2) = Value
Index2 = Index2 + 1
If Index2 > UBound(SourceArray2) Then Exit Do
Loop
End If
Loop Until Index1 > UBound(SourceArray1) Or Index2 > UBound(SourceArray2)
If Count > 0 Then
TrimArray Result, Count
GetArrayIntersection = Result
Else
GetArrayIntersection = Array()
End If
End Function
Public Function GetArrayUnion( _
ByVal SourceArray1 As Variant, _
ByVal SourceArray2 As Variant, _
Optional ByVal Sorted As Boolean _
) As Variant
' Return the union of the two arrays containing all of the unique elements.
' If there is no intersection then an Empty is returned. The lower bound of the
' first source array is used as the base for the new array. To speed up the
' routine pass in sorted arrays (using the SortArray function) and pass True
' for the parameter Sorted. The returned array is always sorted in ascending
' order.
'
' Syntax
'
' GetArrayUnion(SourceArray1, SourceArray2, [Sorted])
'
' SourceArray1 - Any single dimension array.
'
' SourceArray2 - Any single dimension array.
'
' Sorted - Pass True if both source arrays are sorted, False otherwise.
Dim Index1 As Long
Dim Index2 As Long
Dim Result As Variant
Dim Count As Long
If Not IsOneDimensionArray(SourceArray1) Then Stop ' Invalid parameter
If Not IsOneDimensionArray(SourceArray2) Then Stop ' Invalid parameter
If Not Sorted Then
SortArray SourceArray1
SortArray SourceArray2
End If
If GetArrayElementCount(SourceArray1) = 0 Then
GetArrayUnion = SourceArray2
Exit Function
End If
If GetArrayElementCount(SourceArray2) = 0 Then
GetArrayUnion = SourceArray1
Exit Function
End If
Index1 = LBound(SourceArray1)
Index2 = LBound(SourceArray2)
AddArrayElement Result, SourceArray1(Index1), Base:=LBound(SourceArray1), Increment:=100, Count:=Count
Index1 = Index1 + 1
If SourceArray1(Index1) <> SourceArray2(Index2) Then
AddArrayElement Result, SourceArray2(Index2), Count:=Count
End If
Index2 = Index2 + 1
Do While Index1 <= UBound(SourceArray1) Or Index2 <= UBound(SourceArray2)
If Index1 < UBound(SourceArray1) Then
Do While (SourceArray1(Index1) = SourceArray1(Index1 - 1) Or SourceArray1(Index1) = Result(LBound(Result) + Count - 1)) And Index1 < UBound(SourceArray1)
Index1 = Index1 + 1
Loop
End If
If Index2 < UBound(SourceArray2) Then
Do While (SourceArray2(Index2) = SourceArray2(Index2 - 1) Or SourceArray2(Index2) = Result(LBound(Result) + Count - 1)) And Index2 < UBound(SourceArray2)
Index2 = Index2 + 1
Loop
End If
If Index1 <= UBound(SourceArray1) Then
If Index2 <= UBound(SourceArray2) Then
If SourceArray1(Index1) <= SourceArray2(Index2) Then
AddArrayElement Result, SourceArray1(Index1), Increment:=100, Count:=Count
Index1 = Index1 + 1
End If
Else
AddArrayElement Result, SourceArray1(Index1), Increment:=100, Count:=Count
Index1 = Index1 + 1
End If
End If
If Index2 <= UBound(SourceArray2) Then
If Index1 <= UBound(SourceArray1) Then
If SourceArray2(Index2) < SourceArray1(Index1) And SourceArray2(Index2) <> Result(LBound(Result) + Count - 1) Then
AddArrayElement Result, SourceArray2(Index2), Increment:=100, Count:=Count
Index2 = Index2 + 1
End If
Else
If SourceArray2(Index2) <> Result(LBound(Result) + Count - 1) Then
AddArrayElement Result, SourceArray2(Index2), Increment:=100, Count:=Count
End If
Index2 = Index2 + 1
End If
End If
Loop
If Count > 0 Then TrimArray Result, Count
GetArrayUnion = Result
End Function
Public Function GetArrayUniqueElements( _
ByVal SourceArray As Variant, _
ByVal BaseArray As Variant, _
Optional ByVal Sorted As Boolean _
) As Variant
' Return the unique elements from the source array that are not in the base
' array. If there are no unique elements then Empty is returned. The lower
' bound of the first source array is used as the base for the new array. To
' speed up the routine pass in sorted arrays (use the SortArray function) and
' pass True for the parameter Sorted. The returned array is always sorted in
' ascending order.
'
' Syntax
'
' GetArrayUniqueElements(SourceArray, BaseArray, [Sorted])
'
' SourceArray - Any single dimension array.
'
' BaseArray - Any single dimension array.
'
' Sorted - Pass True if the source and base arrays are sorted, False otherwise.
Dim CommonElements As Variant
If Not Sorted Then
SortArray SourceArray
SortArray BaseArray
End If
CommonElements = GetArrayIntersection(SourceArray, BaseArray, True)
GetArrayUniqueElements = GetArrayDifference(CommonElements, SourceArray, True)
End Function
Public Sub InsureArrayInitialized( _
ByRef SourceArray As Variant, _
Optional ByVal Base As Long = 0, _
Optional ByVal Size As Long = 1 _
)
' Insure array is initialized with at least one element.
Dim Error As Long
If Size < 1 Then Size = 1
If Not IsArrayInitialized(SourceArray) Then
If Base = 0 And Size = 1 Then
On Error Resume Next
SourceArray = Array(0)
Error = Err
On Error GoTo 0
End If
If Error = 458 Or Base <> 0 Or Size <> 1 Then
ReDim SourceArray(Base To Base + Size - 1)
End If
End If
End Sub
Public Function IsArrayInitialized( _
ByVal SourceArray As Variant _
) As Boolean
' Return True if the array is initialized, False otherwise. An inialized array
' has a lower and upper bound, although it may not have any elements (the upper
' bound is less than the lower bound).
Dim UpperBound As Long
UpperBound = -1
On Error Resume Next
UpperBound = UBound(SourceArray)
On Error GoTo 0
IsArrayInitialized = UpperBound > -1
End Function
Public Function IsOneDimensionArray( _
ByVal SourceArray As Variant _
) As Boolean
' Return True if the source array is a one-dimension array, False otherwise.
Dim Result As Long
On Error Resume Next
Result = LBound(SourceArray, 2)
IsOneDimensionArray = Err.Number <> 0
End Function
Public Sub SortArray( _
ByRef SourceArray As Variant, _
Optional ByVal FirstParm As Variant, _
Optional ByVal LastParm As Variant _
)
' Sort the array. Array can be a single dimension array of any variable type or
' a variant containing an array such as the result of the Array function.
Dim First As Long
Dim Last As Long
Dim Low As Long
Dim High As Long
Dim Temp As Variant
Dim Pivot As Variant
If Not IsOneDimensionArray(SourceArray) Then Stop ' Invalid parameter
If GetArrayElementCount(SourceArray) = 0 Then Exit Sub
If UBound(SourceArray) - LBound(SourceArray) < 2 Then Exit Sub
If IsMissing(FirstParm) Then
First = LBound(SourceArray)
Else
First = FirstParm
End If
If IsMissing(LastParm) Then
Last = UBound(SourceArray)
Else
Last = LastParm
End If
Low = First
High = Last
Pivot = SourceArray(Application.Max((First + Last) 2, LBound(SourceArray)))
While Low <= High
Do
If SourceArray(Low) < Pivot And Low < Last Then
Low = Low + 1
Else
Exit Do
End If
Loop
Do
If Pivot < SourceArray(High) And High > First Then
High = High - 1
Else
Exit Do
End If
Loop
If Low <= High Then
If Low < High Then
Temp = SourceArray(High)
SourceArray(High) = SourceArray(Low)
SourceArray(Low) = Temp
End If
Low = Low + 1
High = High - 1
End If
Wend
If (First < High) Then SortArray SourceArray, First, High
If (Low < Last) Then SortArray SourceArray, Low, Last
End Sub
Public Sub TrimArray( _
ByRef SourceArray As Variant, _
ByVal Count As Long _
)
' Redimension the source array so that it contains exactly the specified number
' of elements.
'
' Syntax
'
' TrimArray(SourceArray, Count)
'
' ValueArray - Any dynamic one-dimensional array.
'
' Count - The number of elements after trimming.
If Not IsOneDimensionArray(SourceArray) Then Stop ' Array must be one dimension
If GetArrayElementCount(SourceArray) > Count Then
ReDim Preserve SourceArray(LBound(SourceArray) To LBound(SourceArray) + Count - 1)
End If
End Sub
Postado : 21/09/2017 12:12 pm