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.