Макрос VBA Excel для суммирования повторяющихся значений и последующего удаления дублирующихся записей

Question

Я пытаюсь суммировать значения на основе дубликатов, найденных в столбцах «AO».Использую макрос ниже.Имеется около 500 тыс. Записей, и приведенный ниже макрос зависает плохо.

 Sub Formulae(TargetCol1, TargetCol2, ConcatCol, Col1, Col2, StartRow, EndRow, Sheet)

         Sheets(Sheet).Range(TargetCol1 & CStr(StartRow)).Formula = "=SUMIF($" & ConcatCol & "$" & CStr(StartRow) & ":$" & ConcatCol & "$" & CStr(EndRow) & "," & ConcatCol & CStr(StartRow) & ",$" & Col1 & "$" & CStr(StartRow) & ":$" & Col1 & "$" & CStr(EndRow) & ")"

     Sheets(Sheet).Range(TargetCol1 & CStr(StartRow)).Select
    Selection.Copy
    Sheets(Sheet).Range(TargetCol1 & CStr(EndRow)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Application.CutCopyMode = False
    Selection.FillDown

    Call PasteSpecial(TargetCol1, "T", StartRow, EndRow)

    Sheets(Sheet).Range(TargetCol2 & CStr(StartRow)).Formula = "=SUMIF($" & ConcatCol & "$" & CStr(StartRow) & ":$" & ConcatCol & "$" & CStr(EndRow) & "," & ConcatCol & CStr(StartRow) & ",$" & Col2 & "$" & CStr(StartRow) & ":$" & Col2 & "$" & CStr(EndRow) & ")"

     Sheets(Sheet).Range(TargetCol2 & CStr(StartRow)).Select
    Selection.Copy
    Sheets(Sheet).Range(TargetCol2 & CStr(EndRow)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Application.CutCopyMode = False
    Selection.FillDown

    Call PasteSpecial(TargetCol2, "U", StartRow, EndRow)


 End Sub


Sub PasteSpecial(Col1, Col2, StartRow, EndRow)

    Range(Col1 & CStr(StartRow)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(Col2 & CStr(StartRow)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Позвольте мне кратко объяснить макрос.У меня есть столбцы "AO", и я должен сгруппировать их ... на основе группировки я должен суммировать столбцы "P, Q".У меня есть функция, которая делает объединенную строку из 16 столбцов и сохраняет в столбце «AA».Основываясь на этом столбце, я использую функцию sumif для суммирования всех повторяющихся значений

 =SUMIF($AA$2:$AA$500000,$AA2,$P$2:$P$500000)
 =SUMIF($AA$2:$AA$500000,$AA2,$Q$2:$Q$500000)

Затем я копирую вставить в качестве 'значений' специальные значения как указанные выше значения, чтобы удалить формулу, в 2 новых столбцах (функция pasteSpecial в приведенном выше макросекод).

Наконец, я вызываю команду удаления дубликатов, чтобы удалить дублирующиеся значения.

Я использовал метод .removeduplicates, который, кажется, работает довольно быстро даже на таком огромном наборе данных.Существует ли в Excel какая-либо предопределенная функция, которая бы суммировала значения дубликатов, а затем удаляла дубликаты?

 Sub Remove_Duplicates_In_A_Range(StartRow, EndRow, Sheet, StartCol, EndCol, level)



Sheets(Sheet).Range(StartCol & CStr(StartRow) & ":" & EndCol & CStr(EndRow)).RemoveDuplicates Columns:=20, Header:=xlNo

End Sub

Приведенная выше логика плохо зависает, съедая все ресурсы процессора и приводя к сбою ...

Кто-нибудь, пожалуйста, оптимизируйте макрос выше, чтобы он работал с 500k + записями.Максимальная производительность 1-2 минуты.

Пожалуйста, помогите !!!

РЕДАКТИРОВАТЬ: 500k + записи Я имею в виду A1: O500000.Таким способом я должен проверить наличие дубликатов комбинации A1, B1, C1, D1, E1, F1, G1, H1, I1, J1, K1, L1, M1, N1, O1 с A2, B2, C2, D2,E2, F2, G2, H2, I2, J2, K2, L2, M2, N2, O2 и A3, B3, C3, D3, E3, F3, G3, H3, I3, J3, K3, L3, M3, N3,O3 и т. Д. .... до A500000, B500000 и т. Д. ...

Короче говоря, я должен проверить все совпадения набора A1-O1 со всем A2-O2 или A3-O3 или ..... A500k-O500k и т. Д.

Для каждого совпадения всего набора записей AO мне нужно суммировать их соответствующие столбцы P, Q.Например, набор A1-O1, соответствующий набору A2-O2, затем добавьте P1, Q1 и P2, Q2 и сохраните в P1, Q1 или что-то в этом роде.

В любом случае мне нужно сохранить каждый исходный набор записей, например, A1-O1 с суммированными значениями его дубликатов и его собственных в P1, Q1

Не думаю, что мы можем прикрепить здесь демонстрационную таблицу Excel, не так ли?: (*

РЕДАКТИРОВАТЬ2:

Функция для репликации формулы Sumif во всех ячейках

 Sub PreNettingBenefits(StartRow1, EndRow1, StartRow2, EndRow2, Col_Asset, Col_Liab, Src_Col_Asset, Src_Col_Liab, ConcatCol, Src_ConcatCol, level, Sheet2, Sheet1)

'=SUMIF(Sheet1!$AA$2:$AA$81336,Sheet2!AA2,Sheet1!$P$2:$P$81336)
Application.Calculation = xlCalculationAutomatic
Sheets(Sheet2).Range(Col_Asset & CStr(StartRow2)).Formula = "=SUMIF(" & Sheet1 & "!$" & Src_ConcatCol & "$" & CStr(StartRow1) & ":$" & Src_ConcatCol & "$" & CStr(EndRow1) & "," & Sheet2 & "!" & ConcatCol & CStr(StartRow2) & "," & Sheet1 & "!$" & Src_Col_Asset & "$" & CStr(StartRow1) & ":$" & Src_Col_Asset & "$" & CStr(EndRow1) & ")"
Sheets(Sheet2).Range(Col_Asset & CStr(StartRow2)).Select
Selection.Copy
MsgBox Sheets(Sheet2).Range(Col_Asset & CStr(EndRow2)).Address
Sheets(Sheet2).Range(Col_Asset & CStr(EndRow2)).Select
Range(Col_Asset & CStr(StartRow2) & ":" & Col_Asset & CStr(EndRow2)).Select
Application.CutCopyMode = False
Selection.FillDown




Sheets(Sheet2).Range(Col_Liab & CStr(StartRow2)).Formula = "=SUMIF(" & Sheet1 & "!$" & Src_ConcatCol & "$" & CStr(StartRow1) & ":$" & Src_ConcatCol & "$" & CStr(EndRow1) & "," & Sheet2 & "!" & ConcatCol & CStr(StartRow2) & "," & Sheet1 & "!$" & Src_Col_Liab & "$" & CStr(StartRow1) & ":$" & Src_Col_Liab & "$" & CStr(EndRow1) & ")"
Sheets(Sheet2).Range(Col_Liab & CStr(StartRow2)).Select
Selection.Copy
MsgBox Sheets(Sheet2).Range(Col_Liab & CStr(EndRow2)).Address
Sheets(Sheet2).Range(Col_Liab & CStr(EndRow2)).Select
Range(Col_Liab & CStr(StartRow2) & ":" & Col_Liab & CStr(EndRow2)).Select
Application.CutCopyMode = False
Selection.FillDown


Application.Calculation = xlCalculationManual


End Sub

Это зависает очень плохо. Что проблема в репликацииформула для строк 30–40 тыс. Кто-нибудь может оптимизировать код?

Answer 1

Что-то должно быть ужасно неправильно с тем, как вы делаете добавление дубликатов. Поскольку у вас было мало информации о данных, с которыми вы работаете, я не знаю, совпадает ли это с тем, но я заполнил A1: O33334 (более 500 тыс. Ячеек) случайным числом от 1 до 10000.

Используя объект словаря (я известен своей любовью и чрезмерным использованием), я просмотрел все из них и суммировал только дублированные значения, а затем добавил уникальный список элементов в столбец A на листе 2.

Причины использования словаря:

• Вы можете отсеять дубликаты
• Вы можете проверить, существует ли значение в словаре или нет
• Вы можете легко перенести уникальный список в Excel

Проверка дублирования, добавление и копирование уникальных ячеек занимает всего 2 секунды . Вот код для вашей справки.

Sub test()

Application.ScreenUpdating = False
Dim vArray As Variant
Dim result As Long
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

vArray = Range("A1:O33334").Value

On Error Resume Next
For i = 1 To UBound(vArray, 1)
    For j = 1 To UBound(vArray, 2)
        If dict.exists(vArray(i, j)) = False Then
            dict.Add vArray(i, j), 1
        Else
            result = result + vArray(i, j)
        End If
    Next
Next

Sheet2.Range("a1").Resize(dict.Count).Value = _
Application.Transpose(dict.keys)

Application.ScreenUpdating = True
MsgBox "Total for duplicate cells: " & result & vbLf & _
    "Unique cells copied: " & dict.Count

End Sub

Answer 2

Вы не должны select каждую ячейку при выполнении кода.

Кстати, если вы посмотрите на свой код, некоторые утверждения бесполезны:

Sheets(Sheet).Range(TargetCol1 & CStr(StartRow)).Select
Selection.Copy

никогда не вставляется

Что касается производительности, см. Несколько советов в этой теме: Сравнительный код VBA

Answer 3

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

Вот несколько шагов, которые я бы предпринял. Измените их в соответствии с вашими потребностями:

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

=concatenate(a2,b2,c2,d2,e2)

Создайте столбец с именем Dups и используйте для его заполнения следующее:

=if(countif(dataSetNamedRange,aa2)>1,1,0)

В приведенном выше коде aa2 относится к объединенному столбцу для этой строки. Результатом вышеизложенного является то, что у вас теперь все помечены флажками. Теперь используйте инструменты фильтра в меню «Данные», чтобы создать сортировку или фильтр в соответствии с потребностями группировки. Чтобы сложить значения, используйте DSum. Чтобы удалить дубли, используйте расширенный фильтр. Удачи.

Answer 4

Я добавляю это как второй ответ, так как он будет длинным ...

Потому что я упрямый мул, я пробовал много разных вещей, я думаю, вы достигли предела того, что может делать Excel. Лучшая функция, которую я мог придумать, была следующая: обратите внимание, что я использую 50 000 строк, а не ваши 500 000:

• 50 000 строк с 100 уникальными строками, случайным образом распределенными: 1 м: 47 с
• 50 000 строк с 50 уникальными строками, случайное распределение: 57 с
• 50000 строк с 25 уникальными строками, случайное распределение: 28 с
• 50 000 строк с 10 уникальными строками, случайное распределение: 12 с
• 50 000 строк с 5 уникальными строками, случайным образом распределенными: 6 с

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

• Я беру весь диапазон ячеек 750 КБ и помещаю его в массив вариантов (.2 секунды)
• Я сбрасываю строки P & Q в аналогичный вариантный массив для последующего использования
• Я создаю массив из 50 000 строк (строк) из альтернативного массива (всего 1 секунда или около того!)
• Я прощаюсь с массивом вариантов для очистки памяти
• Я запускаю свой цикл через каждую строку, сравнивая со всеми строками 50k ...
• Если найдена строка дублирования, она добавляется в словарь дублирования, поэтому мы не выполняем этот процесс позже для этой строки
• При обнаружении дубликата его итоги P & Q добавляются к P & Q рассматриваемой строки
• После проверки всех 50-тысячных строк мы складываем сумму в столбец R строки и переходим на
• Если в дубликате ряд был отмечен как дурак, мы его пропускаем (зло, остерегайтесь!)

Sub test()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim rowArray As Variant
Dim totalArray As Variant
Dim i As Long, j As Long
Dim dupeDict As Object
Set dupeDict = CreateObject("scripting.dictionary")
Dim count As Long
Dim rowData() As String

'dump the cells into an single array
rowArray = Range("A1:O50000").Value

'grab totals from P and Q to keep them seperate
totalArray = Range("P1:Q50000").Value

'create strings for each row
ReDim rowData(1 To 50000)

'create a string for each row
For i = 1 To 50000
    For j = 1 To 15
        rowData(i) = rowData(i) & rowArray(i, j)
    Next
Next

'free up that memory
Set rowArray = Nothing

'check all rows, total P & Q if match
On Error Resume Next
For i = 1 To 50000
    'skip row and move to next if we've seen it
    If dupeDict.exists(i) = True Then
        GoTo Dupe
    End If
    count = 0
    For j = 1 To 50000
        If rowData(i) = rowData(j) Then
            dupeDict.Add j, 1 'add that sucker to the dupe dict
            count = count + totalArray(j, 1) + totalArray(j, 2)
        End If
        'enter final total in column R
        Cells(i, 18).Value = count
    Next
Dupe:
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub