View Single Post
  #33   Report Post  
Posted to microsoft.public.excel.programming
Albert Albert is offline
external usenet poster
 
Posts: 203
Default Append One Array to Another, and Consolidate

You are right, my algorithm was flawed.
Here it is fixed.
Please tell me how it you find any more bugs.
Thx,
Albert

Sub ArrayConsolidator(Array1, Array2)

' Alberto Cattan Rozenfarb
'
' 17 de Noviembre de 2006

' Array1 y Array2 son dos arrays exógenos que pueden o no tener elementos
duplicados
' Array1 and Array2 are two exogenous arrays which may or may not have
duplicated registers
' Array1 = Range("A1", "L19")
' Array2 = Range("A20", "L42")
If Not UBound(Array1, 2) = UBound(Array2, 2) Then
MsgBox "La segunda dimensión de los dos arrays debe tener el mismo
UBound." & vbCrLf & "The second dimension for both arrays must have the same
UBound."
Exit Sub
End If

' Se crea Array3 que es una combinación de Array1 y Array2.
' Tiene 2 columnas extra para reconocer registros duplicados.
' We create Array3 which is a blunt combination of Array1 and Array2
' It has 2 extra columns which we will use to identify and eliminate
duplicates.
ReDim Array3(1 To UBound(Array1) + UBound(Array2), 1 To UBound(Array1,
2) + 2)
For x = 1 To UBound(Array1)
For Y = 1 To UBound(Array1, 2)
Array3(x, Y) = Array1(x, Y)
Next Y
Next x
For x = 1 To UBound(Array2)
For Y = 1 To UBound(Array1, 2)
Array3(UBound(Array1) + x, Y) = Array2(x, Y)
Next Y
Next x

' Se genera una columna con un Concatenado de todas las demás columnas.
' Esta es la llave para reconocer duplicados
' We generate a column which concatenates all the columns in arrays 1&2
' We will use this column to identify duplicates
For x = 1 To UBound(Array3)
For g = 1 To UBound(Array1, 2)
Array3(x, UBound(Array2, 2) + 1) = Array3(x, UBound(Array2, 2) +
1) & Array3(x, g)
Next g
Next x

' Se ordena la matriz por esta (pen-última) columna
' We sort the array with the concatenated column as key
Call QuickSort(Array3, UBound(Array3, 2) - 1, LBound(Array3),
UBound(Array3), True)


' En la última columna se marcan los registros repetidos
' In the last column we identify and mark duplicates
For x = 2 To UBound(Array3)
If Array3(x, UBound(Array3, 2) - 1) = Array3(x - 1, UBound(Array3,
2) - 1) Then
Array3(x, UBound(Array3, 2)) = "REPETIDO"
End If
Next x

' Se ordena la matriz por orden de registros repetidos y no repetidos.
' We sort the array with the DuplicateIdentify column as key
Call QuickSort(Array3, UBound(Array3, 2), LBound(Array3),
UBound(Array3), True)

' Se cuenta la cantidad de registros NO repetidos, que va a ser el ubound
de la matriz limpia de duplicados.
' We determine the amount of non-duplicates in order to ReDim the clean
array
x = 1
Do Until Array3(x, UBound(Array3, 2)) < Empty Or x = UBound(Array3, 1)
x = x + 1
Loop

' El UBound de ConsolidatedArray depende de que haya o no duplicados.
' ConsolidatedArray's UBound depends on wheather or not there are
duplicated registers.
Dim ThereAreDuplicates As Boolean
ThereAreDuplicates = False
If Not x = UBound(Array3, 1) Then
ThereAreDuplicates = True
ElseIf x = UBound(Array3, 1) Then
If Array3(UBound(Array3, 1), UBound(Array3, 2)) = "REPETIDO" Then
ThereAreDuplicates = True
End If
End If
' Array4 es la matriz limpia de duplicados. En vista de que los duplicados
ya fueron excluÃ*dos, ya no se necesitan las dos columnas extras.
' Array4 is the duplicate-free array. Since the duplicates have been
identified and sent to the end, we no longer need the extra columns.
If ThereAreDuplicates = True Then
ReDim ConsolidatedArray(1 To x - 1, 1 To UBound(Array2, 2))
ElseIf ThereAreDuplicates = False Then
ReDim ConsolidatedArray(1 To x, 1 To UBound(Array2, 2))
End If
For x = 1 To UBound(ConsolidatedArray, 1)
For Y = 1 To UBound(ConsolidatedArray, 2)
ConsolidatedArray(x, Y) = Array3(x, Y)
Next Y
Next x

End Sub