excel - unir - Combine dos tablas grandes en una tabla basada en una ID única

tabla anidada excel

Question

Para empezar, tengo poco conocimiento de VBA y no he intentado escribir un código para lo que quiero hacer, ya que ni siquiera sé por dónde empezar.

Actualmente tengo dos tablas. La Tabla 1 contiene 48000 filas de datos y dos columnas, un identificador único y un importe en efectivo para cada ID. La Tabla 2 contiene 50000 filas de datos y dos columnas, un identificador único y un importe en efectivo para cada ID. Los números de identificación son exclusivos de su propia tabla, por lo que a menudo hay identificaciones repetidas en la otra tabla. El objetivo de esto es combinar las dos tablas por número de ID y mostrar el monto total en efectivo para cada número de ID.

Mi primer intento fue utilizar la función SUMAR.SI para obtener los totales de ambas tablas. Aunque esto funcionó para la primera ID, cuando traté de copiar la fórmula a las otras celdas, mi laptop colapsó por completo forzando un reinicio.

Mi segundo intento consistió en utilizar el asistente de tablas dinámicas para combinar los dos rangos. Sin embargo, descubrí que las tablas dinámicas no pueden manejar estos muchos valores únicos. (Basado en la ventana emergente que apareció).

Mi tercer intento funcionó, pero lo encontré largo y espero que haya un método mejor. Divido mis tablas en dos rangos de aproximadamente 20,000 filas (por lo que ahora hay 4 tablas). Luego usé el asistente de tabla dinámica para combinar estos dos a la vez. Primero fue Table1 y Table3, luego Table2 y Table4. Luego tuve que dividir las listas resultantes nuevamente ya que PivotTable no podía manejarlo y repetí este proceso. El problema con este método es que creo que hay una posibilidad definitiva de valores perdidos o repetidos debido a la división.

Durante los tres intentos, mi computadora tuvo problemas repetidamente y requirió reinicios.

No me importa si una solución de VBA tarda un tiempo en ejecutarse, siempre y cuando funcione.

He tratado de buscar otros ejemplos, pero algunos no pude encontrar la manera de aplicarlos a mi situación y otros parecían no estar trabajando con archivos lo suficientemente grandes como para experimentar algunos de los problemas que estoy enfrentando.

Gracias y, por favor, avíseme si necesita alguna aclaración sobre algo.

Answer 1

Al final, utilicé el Asistente de tabla dinámica para combinar los rangos en lotes de 10.000.

Gracias por tu ayuda.

Answer 2

Aquí hay un intento de obtener una tabla ordenada y combinada. La estrategia general que he empleado aquí es: hacer copias de tablas existentes y usarlas para agregar valores, eliminar valores repetitivos y hacer lo mismo para la tercera tabla combinada en la hoja 3. Adjunte el siguiente código a un botón de comando.

Application.ScreenUpdating = False
Dim i As Long, x As Long, n As Long, j As Long
Dim cashtotal As Integer
lastrow1 = Sheet1.Range("A1048575").End(xlUp).Row
astrow2 = Sheet2.Range("A1048575").End(xlUp).Row
cashtotal = 0
x = 1
''''''''''Routine to make a copy of the existing data.
For i = 1 To lastrow1
Sheet1.Cells(i, 4) = Sheet1.Cells(i, 1)
Sheet1.Cells(i, 5) = Sheet1.Cells(i, 2)
Next
''''''''''On Sheet1- Routine to remove repetitive values
For i = 2 To lastrow1
If Sheet1.Cells(i, 4) = "" Then GoTo 10
x = x + 1
cashtotal = Sheet1.Cells(i, 5)
Sheet1.Cells(x, 7) = Sheet1.Cells(i, 4)
Sheet1.Cells(x, 8) = Sheet1.Cells(i, 5)
For j = i + 1 To lastrow1
If Sheet1.Cells(j, 4) = Sheet1.Cells(i, 4) Then
cashtotal = cashtotal + Sheet1.Cells(j, 5)
Sheet1.Cells(x, 8) = cashtotal
Sheet1.Cells(j, 4).ClearContents
Sheet1.Cells(j, 5).ClearContents
End If
Next
10
Next
x = 1
''''''''''On Sheet2 the following routine makes a copy of the existing data
For i = 1 To lastrow2
Sheet2.Cells(i, 4) = Sheet2.Cells(i, 1)
Sheet2.Cells(i, 5) = Sheet2.Cells(i, 2)
Next
''''''''''On sheet2 - Routine to remove repetitive values
For i = 2 To lastrow2
If Sheet2.Cells(i, 4) = "" Then GoTo 20
x = x + 1
cashtotal = Sheet2.Cells(i, 5)
Sheet2.Cells(x, 7) = Sheet2.Cells(i, 4)
Sheet2.Cells(x, 8) = Sheet2.Cells(i, 5)
For j = i + 1 To lastrow2
If Sheet2.Cells(j, 4) = Sheet2.Cells(i, 4) Then
cashtotal = cashtotal + Sheet2.Cells(j, 5)
Sheet2.Cells(x, 8) = cashtotal
Sheet2.Cells(j, 4).ClearContents
Sheet2.Cells(j, 5).ClearContents
End If
Next
20
Next
x = 1
''''''Transfer modified tables on sheet1 and sheet2 to sheet3 in a combined table
lastrow4 = Sheet1.Range("G1048575").End(xlUp).Row
For i = 1 To lastrow4
Sheet3.Cells(i, 1) = Sheet1.Cells(i, 7)
Sheet3.Cells(i, 2) = Sheet1.Cells(i, 8)
Next
lastrow5 = Sheet2.Range("G1048575").End(xlUp).Row
lastrow6 = Sheet3.Range("A1048575").End(xlUp).Row
For i = 2 To lastrow5
Sheet3.Cells(lastrow6 + i - 1, 1) = Sheet2.Cells(i, 7)
Sheet3.Cells(lastrow6 + i - 1, 2) = Sheet2.Cells(i, 8)
Next
''''''''''''''Routine to make a copy of the existing table
lastrow7 = Sheet3.Range("A1048575").End(xlUp).Row
For i = 1 To lastrow7
Sheet3.Cells(i, 4) = Sheet3.Cells(i, 1)
Sheet3.Cells(i, 5) = Sheet3.Cells(i, 2)
Next
'''''''''''''''' Routine to remove repetitive values
For i = 2 To lastrow7
If Sheet3.Cells(i, 4) = "" Then GoTo 30
x = x + 1
cashtotal = Sheet3.Cells(i, 5)
Sheet3.Cells(x, 7) = Sheet3.Cells(i, 4)
Sheet3.Cells(x, 8) = Sheet3.Cells(i, 5)
For j = i + 1 To lastrow7
If Sheet3.Cells(j, 4) = Sheet3.Cells(i, 4) Then
cashtotal = cashtotal + Sheet3.Cells(j, 5)
Sheet3.Cells(x, 8) = cashtotal
Sheet3.Cells(j, 4).ClearContents
Sheet3.Cells(j, 5).ClearContents
End If
Next
30
Next
Application.ScreenUpdating = True

Answer 3

Sugeriría conectarse a las hojas de trabajo a través de una conexión ADO y unir las dos tablas con una declaración SQL.

Agregue una referencia a la biblioteca Microsoft ActiveX Data Objects ( Herramientas -> Referencias ... ) - use la última versión, que generalmente es 6.1.

Inserta un módulo en el proyecto de VBA y pega el siguiente código:

Sub JoinTables()
''Create a connection to the current workbook
Dim conn As New ADODB.Connection
With conn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=""" & ActiveWorkbook.FullName & """;" & _
"Extended Properties=""Excel 12.0;HDR=Yes"""
.Open
End With
''The SQL statement that shapes the resulting data
Dim sql As String
sql = _
"SELECT t1.ID, t1.Value + IIF(t2.Value IS NULL, 0, t2.Value) AS FinalSum " & _
"FROM [Sheet1$] AS t1 " & _
"LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID " & _
"UNION SELECT t2.ID, t2.Value " & _
"FROM [Sheet2$] AS t2 " & _
"LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID " & _
"WHERE t1.ID IS NULL"
Dim rs As ADODB.Recordset
''All the fun happens here
Set rs = conn.Execute(sql)
''Paste the resulting records into the third sheet of the active workbook
ActiveWorkbook.Sheets(3).Cells(2, 1).CopyFromRecordset rs
conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub

Notas:

• Actualmente, la conexión ADO está utilizando datos del libro actual (Excel). Si los datos provienen de una base de datos, puede ser más simple conectarse a la base de datos directamente y emitir la declaración SQL en contra de la base de datos.

• El código busca los nombres de hoja Sheet1 y Sheet2 , y los ID y Value encabezados de columna.

• El código supone que la primera línea de cada hoja de cálculo contiene las etiquetas de las columnas, por ejemplo, ID y Value .

• Los resultados se pegan en la tercera hoja del libro activo. Esto puede o no ser apropiado.

• No especifica cómo desea ordenar los datos, pero eso es lo suficientemente simple con la adición de una cláusula ORDER BY a la instrucción SQL.

Explicación de la declaración de SQL

Estamos comparando dos tablas. Para una identificación dada, podría haber tres posibilidades:
1. la identificación aparece en ambas tablas,
2. aparece solo en la primera tabla, o
3. aparece solo en la segunda mesa.

También estamos trabajando con la suposición de que la ID es única dentro de cada mesa.

La primera mitad de la declaración (hasta UNION ) maneja 1 y 2.

SELECT t1.ID, t1.Value + IIF(t2.Value IS NULL, 0, t2.Value) AS FinalSum
FROM [Sheet1$] AS t1
LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID

Se puede describir de la siguiente manera:

Comience con los registros en la primera tabla: FROM [Sheet1$] AS t1

Haga coincidir cada registro en la segunda tabla con el registro correspondiente en la primera tabla, basado en ID - LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID

Incluye todos los registros de la primera tabla y solo coincide con los registros de la segunda tabla: LEFT en LEFT JOIN

Devuelve dos columnas: la ID de la primera tabla y la combinación de los valores de la primera y la segunda tabla: SELECT ...

Si no hay un registro coincidente en la segunda tabla, el valor será NULL (no el mismo que cero). Intentar agregar un número a NULL devolverá NULL, que no es lo que queremos. Entonces tenemos que escribir esta fórmula - t1.Value + IIF(t2.Value IS NULL, 0, t2.Value) :

• Si el valor de la segunda tabla es nulo, agregue 0

• de lo contrario, agregue el valor de la segunda tabla

La segunda mitad de la instrucción maneja los ID que aparecen solo en la segunda tabla:

UNION
SELECT t2.ID, t2.Value
FROM [Sheet2$] AS t2
LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID
WHERE t1.ID IS NULL

Agregue un segundo conjunto de resultados sobre el primer conjunto de resultados - UNION

Comience con los registros de la segunda tabla: FROM [Sheet2$] AS t2

Haga coincidir los registros de la primera tabla con los registros de la segunda tabla (tenga en cuenta que esto se invierte desde la primera mitad de la consulta) - LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID

Solo queremos registros que no tengan una ID en la primera tabla, WHERE t1.ID IS NULL

Answer 4

Si desea una solución de VBA que no utilice tablas dinámicas, puede intentar crear un objeto de diccionario y usar la ID como clave y el valor en efectivo como valor. Me gusta esto. Primero debe agregar una referencia a Microsoft Scripting Runtime.

Sub CreateEmployeeSum()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim table1 As Worksheet, _
table2 As Worksheet, finalTable As Worksheet
''wasn''t sure if you were using sheets of data
''or actual tables - if they are actual tables,
''you can loop through those in a similar way, look up
''on other problems how
Set table1 = wb.Sheets("Sheet1") ''first sheet of info
Set table2 = wb.Sheets("Sheet2") ''second sheet of info
Set finalTable = wb.Sheets("Sheet3") ''destination sheet
''get the last row of both tables
Dim lastRowT1 As Long, lastRowT2 As Long
lastRowT1 = table1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastRowT2 = table2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
''write the info to arrays so faster to loop through
Dim t1Array As Variant, t2Array As Variant
t1Array = table1.Range("A1:B" & lastRowT2).Value
t2Array = table2.Range("A1:B" & lastRowT2).Value
''create a dictionary that maps IDs to cash value
Dim idToCashDict As Dictionary
Set idToCashDict = New Dictionary
''first loop through info from first sheet
Dim i As Long
For i = 1 To UBound(t1Array)
Dim idNum As String, cashVal As Double
idNum = CStr(t1Array(i, 1))
cashVal = CDbl(t1Array(i, 2))
If idToCashDict.Exists(idNum) Then
cashVal = cashVal + idToCashDict.Item(idNum)
idToCashDict.Remove idNum
idToCashDict.Add idNum, cashVal
Else
idToCashDict.Add idNum, cashVal
End If
Next i
''then through second sheet, adding to cash value of
''ids that have been seen before
For i = 1 To UBound(t2Array)
Dim idNum2 As String, cashVal2 As Double
idNum2 = CStr(t2Array(i, 1))
cashVal2 = CDbl(t2Array(i, 2))
If idToCashDict.Exists(idNum2) Then
cashVal2 = cashVal2 + idToCashDict.Item(idNum2)
idToCashDict.Remove idNum2
idToCashDict.Add idNum2, cashVal2
Else
idToCashDict.Add idNum2, cashVal2
End If
Next i
''then write the entries from the dictionary to the
''destination sheet
Dim finalVal As Double, finalID As String
i = 1
For Each finalID In idToCashDict.Keys
finalVal = idToCashDict.Item(finalID)
finalTable.Range("A" & i).Value = finalID
finalTable.Range("B" & i).Value = finalVal
i = i + 1
Next finalID
End Sub

Si usa tablas reales, vea las respuestas como aquí para recorrer las filas de manera similar.