View Single Post
  #34   Report Post  
Posted to microsoft.public.excel.programming
Alan Beban Alan Beban is offline
external usenet poster
 
Posts: 200
Default Append One Array to Another, and Consolidate

What were the fixes? I don't want to have to go through the code line by
line.

Alan Beban

Albert wrote:
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