Объедините две большие таблицы в одну таблицу на основе уникального идентификатора

Для начала, я немного знаю VBA и не пытался написать код для того, что я хочу сделать, потому что я даже не знаю, с чего начать.

В настоящее время у меня есть две таблицы. Таблица 1 содержит 48000 строк данных и два столбца, уникальный идентификатор и сумму наличных для каждого идентификатора. Таблица 2 содержит 50000 строк данных и два столбца, уникальный идентификатор и сумму наличных для каждого идентификатора. Идентификационные номера являются уникальными для их собственной таблицы, поэтому в другой таблице часто встречаются повторяющиеся идентификаторы. Цель этого состоит в том, чтобы объединить две таблицы по идентификационному номеру и показать общую сумму наличных для каждого идентификационного номера.

Моя первая попытка была связана с использованием функции SUMIF для получения итоговых сумм из обеих таблиц. Несмотря на то, что это работало для первого идентификатора, когда я попытался скопировать формулу в другие ячейки, мой ноутбук завис полностью, что привело к перезагрузке.

Моя вторая попытка состояла в использовании мастера сводных таблиц для объединения двух диапазонов. Однако я обнаружил, что сводные таблицы не могут обрабатывать столько уникальных значений. (Основываясь на появившемся всплывающем окне).

Моя третья попытка сработала, но я нашел это долго, и я надеюсь, что есть лучший метод. Я разделил свои таблицы на два диапазона по 20 000 строк (так что теперь есть 4 таблицы). Затем я использовал мастер сводных таблиц, чтобы объединить эти два элемента одновременно. Сначала были Таблица1 и Таблица3, затем Таблица2 и Таблица4. Затем мне пришлось снова разделить получающиеся списки, так как PivotTable не смог с этим справиться, и повторил этот процесс. Проблема этого метода в том, что я чувствую, что существует определенная вероятность пропущенных или повторяющихся значений из-за всего разделения.

Во время всех этих трех попыток у моего компьютера неоднократно возникали проблемы и требовалась перезагрузка.

Мне все равно, если решение VBA займет некоторое время, пока оно работает.

Я пытался просмотреть другие примеры, но некоторые я не мог понять, как применить их к моей ситуации, а другие, казалось, не работали с достаточно большими файлами, чтобы столкнуться с некоторыми проблемами, с которыми я сталкиваюсь.

Спасибо и, пожалуйста, дайте мне знать, если вам нужно что-то разъяснить.

Источник

4 ответа

В итоге я использовал мастер сводных таблиц, чтобы объединить диапазоны по 10 000.

Спасибо за помощь.

Источник

Я бы предложил подключиться к рабочим листам через соединение ADO и соединить две таблицы с помощью оператора SQL.

Добавьте ссылку на библиотеку объектов данных Microsoft ActiveX (Инструменты -> Ссылки...) - используйте последнюю версию, как правило, 6.1.

Вставьте модуль в проект VBA и вставьте следующий код:

Sub JoinTables()

Dim connectionString As String
connectionString = _
    "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=""" & ActiveWorkbook.FullName & """;" & _
    "Extended Properties=""Excel 12.0;HDR=Yes"""

'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 New ADODB.Recordset
'All the fun happens here
rs.Open sql, connectionString

'Paste the resulting records into the third sheet of the active workbook
ActiveWorkbook.Sheets(3).Range("A2").CopyFromRecordset rs

Set rs = Nothing

End Sub

Заметки:

  • В настоящее время набор записей читает данные из текущей (Excel) рабочей книги. Если данные поступают из базы данных, может быть проще и эффективнее изменить строку подключения для непосредственного подключения к базе данных и выполнить оператор SQL для базы данных.
  • Код предполагает, что первая строка каждого листа содержит метки столбцов, например ID а также Value, Если это не так, укажите HDR=No в третьей строке connectionString (вместо HDR=Yes), и поля будут автоматически назначаться имена, начиная с F1, F2, так далее.
  • Результаты вставляются в третий лист активной рабочей книги. Это может или не может быть уместным.
  • Вы не указываете, как вы хотите упорядочить данные, но это достаточно просто с добавлением ORDER BY предложение к выражению SQL.

Объяснение оператора SQL

Мы сравниваем две таблицы. Для данного идентификатора может быть три возможности:
1. идентификатор появляется в обеих таблицах,
2. он появляется только в первой таблице, или
3. он появляется только во второй таблице.

Мы также работаем с предположением, что идентификатор уникален в каждой таблице.

Первая половина заявления (до UNION) ручки 1 и 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

Это можно описать следующим образом:

Начните с записей в первой таблице - FROM [Sheet1$] AS t1

Сопоставьте каждую запись во второй таблице с соответствующей записью в первой таблице на основе идентификатора - LEFT JOIN [Sheet2$] AS t2 ON t1.ID = t2.ID

Включить все записи из первой таблицы и только соответствующие записи во второй таблице - LEFT в LEFT JOIN

Вернуть два столбца: идентификатор из первой таблицы и комбинацию значений из первой и второй таблицы - SELECT ...

Если во второй таблице нет совпадающих записей, значение будет НЕДЕЙСТВИТЕЛЬНО (не равно нулю). Попытка добавить число в NULL вернет NULL, а это не то, что нам нужно. Итак, мы должны написать эту формулу - t1.Value + IIF(t2.Value IS NULL, 0, t2.Value):

  • Если значение из второй таблицы равно нулю, добавьте 0

  • в противном случае добавьте значение из второй таблицы

Вторая половина оператора обрабатывает идентификаторы, которые появляются только во второй таблице:

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

Добавить второй набор результатов поверх первого набора результатов - UNION

Начнем с записей из второй таблицы - FROM [Sheet2$] AS t2

Сопоставьте записи из первой таблицы с записями во второй таблице (обратите внимание, что это обратное значение в первой половине запроса) - LEFT JOIN [Sheet1$] AS t1 ON t2.ID = t1.ID

Нам нужны только записи, у которых нет идентификатора в первой таблице - WHERE t1.ID IS NULL

Источник

Вот попытка получить отсортированную и комбинированную таблицу. Общая стратегия, которую я использовал здесь: создайте копии существующих таблиц и используйте их для добавления значений, удаления повторяющихся значений и сделайте то же самое для третьей объединенной таблицы на листе 3. Прикрепите следующий код к кнопке команды.

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
Источник

Если вам нужно решение VBA, в котором не используются сводные таблицы, вы можете попытаться создать объект словаря и использовать идентификатор в качестве ключа, а денежное значение - в качестве значения. как это. Сначала необходимо добавить ссылку на 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 stackru 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

Если вы используете реальные таблицы, посмотрите ответы, например, здесь, чтобы подобным образом пройтись по строкам.

Источник
Другие вопросы по тегам