Более быстрый способ использования Sumifs()

У меня есть еженедельная задача, в которой мне нужно обновить отчет (в настоящее время чуть более 50 тысяч строк), который каждую неделю увеличивается примерно на 500 строк. После того, как новые данные добавлены вручную, я запускаю приведенный ниже код, чтобы выполнить Sumifs() для суммирования данных.

Структура данных следующая: столбцы от A до C являются столбцами критериев (числово-буквенно-цифровые), столбец D содержит количество для суммирования (целые числа). Данные являются смежными. Мой макрос помещает формулу Sumifs() в столбец E — перезаписывая то, что там есть.

У меня вопрос: можно ли выполнить эту задачу быстрее? В настоящее время мне требуется чуть больше минуты, чтобы запустить макрос, но это время увеличивается по мере роста данных.

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

Sub MySumIfs()
Dim LastRow As Long

LastRow = Sheet1.Range("A1").End(xlDown).Row

With Sheet1.Range("E2:E" & LastRow)
    .FormulaR1C1 = "=sumifs(R2C4:R" & LastRow & "C4, R2C1:R" & LastRow & "C1, RC1, R2C2:R" & LastRow & "C2, RC2, R2C3:R" & LastRow & "C3, RC3)"
    .Value = .Value
End With

End Sub

person Community    schedule 21.11.2020    source источник
comment
но ни один из примеров не имеет для меня большого смысла (из-за моего собственного невежества) : тогда, конечно, это возможность для обучения...   -  person chris neilsen    schedule 21.11.2020
comment
Как вы уже заметили, в SO есть много информации об использовании массивов для ускорения кода. Начните с этого   -  person chris neilsen    schedule 21.11.2020


Ответы (1)


Вот еще один способ:

РЕДАКТИРОВАТЬ - обновлено, чтобы добавить средние значения и суммы в мою первоначальную (ошибочную) версию счетчиков...

Sub SetupDummyData()
    Const NUM As Long = 100001
    Range("A1:E1").Value = Array("A_Header", "B_Header", "C_Header", "Value", "ResultHere")
    Range("A2:A" & NUM).Formula = "=""A#"" & round(RAND()*10,0)"
    Range("B2:B" & NUM).Formula = "=""B#"" & round(RAND()*10,0)"
    Range("C2:C" & NUM).Formula = "=""C#"" & round(RAND()*10,0)"
    Range("D2:D" & NUM).Formula = "=round(RAND()*100,1)"
    
    Range("A2:D" & NUM).Value = Range("A2:D" & NUM).Value
End Sub


Sub Tester()
    
    Dim arr, ws, rng As Range, keyCols, valueCol As Long, destCol As Long, i As Long, frm As String, sep As String
    Dim t, dict, arrOut(), arrValues(), v, tmp, n As Long
    
    keyCols = Array(1, 2, 3)  'these columns form the composite key
    valueCol = 4              'column with values (for sum)
    destCol = 5               'destination for calculated values
    
    t = Timer
    
    Set ws = ActiveSheet
    Set rng = ws.Range("A1").CurrentRegion
    n = rng.Rows.Count - 1
    Set rng = rng.Offset(1, 0).Resize(n) 'exclude headers
    
    'build the formula to create the row "key"
    For i = 0 To UBound(keyCols)
        frm = frm & sep & rng.Columns(keyCols(i)).Address
        sep = "&""|""&"
    Next i
    arr = ws.Evaluate(frm)  'get an array of composite keys by evaluating the formula
    arrValues = rng.Columns(valueCol).Value  'values to be summed
    ReDim arrOut(1 To n, 1 To 1)             'this is for the results
    
    Set dict = CreateObject("scripting.dictionary")
    'first loop over the array counts the keys
    For i = 1 To n
        v = arr(i, 1)
        If Not dict.exists(v) Then dict(v) = Array(0, 0) 'count, sum
        tmp = dict(v) 'can't modify an array stored in a dictionary - pull it out first
        tmp(0) = tmp(0) + 1                 'increment count
        tmp(1) = tmp(1) + arrValues(i, 1)   'increment sum
        dict(v) = tmp                       'return the modified array
    Next i
    
    'second loop populates the output array from the dictionary
    For i = 1 To n
        arrOut(i, 1) = dict(arr(i, 1))(1)                       'sumifs
        'arrOut(i, 1) = dict(arr(i, 1))(0)                      'countifs
        'arrOut(i, 1) = dict(arr(i, 1))(1) / dict(arr(i, 1))(0) 'averageifs
    Next i
    'populate the results
    rng.Columns(destCol).Value = arrOut
    
    Debug.Print "Checked " & n & " rows in " & Timer - t & " secs"

End Sub
person Tim Williams    schedule 21.11.2020
comment
упс, наверное, я недостаточно внимательно прочитал вопрос (или заголовок...). Позже исправлю... - person Tim Williams; 21.11.2020
comment
@ kevin9999 - спасибо за комментарий. Мне неловко из-за того, что я украл твою галочку. Просто не могу устоять перед ускорением этой задачи... - person Tim Williams; 22.11.2020
comment
Добро пожаловать, Тим, и вполне заслуженно — я был просто рад узнать что-то новое. К сожалению, массивы — это копейки, которые мне еще не достались. Если вы хотите еще раз «ускорить это», ознакомьтесь с моим единственным вопросом: stackoverflow.com/questions/64748492/ Я проверил все ответы, используя 50 000 значений поиска в 200 000 000 стрках (2 столбца), и все они пришли от 7 до 9 секунд (кроме первого это заняло вечность). С наилучшими пожеланиями. - person ; 23.11.2020
comment
Тим, все, что я использовал, это =RANDBETWEEN(1,500) и .value = .value для 50 тысяч значений для поиска, а также 2 столбца (200 тысяч строк) значений для поиска и возврата. Это было действительно просто для проверки скорости всех данных ответов :) - person ; 23.11.2020
comment
Отлично. У меня есть один вопрос: как мы могли бы добиться этого, если бы данные находились на другом листе, а результат должен был быть на другом листе (также столбцы не в том же порядке, что и столбцы листа данных). Спасибо - person Manny; 07.07.2021
comment
@ Мэнни, ну, тебе нужно внести необходимые коррективы? Это все, что я могу сказать на самом деле - в этом методе нет ничего, что означает, что входы и выходы должны быть на одном листе. или даже в той же книге. - person Tim Williams; 07.07.2021
comment
Спасибо за ответ. Я не так хорош в VBA. Не могли бы вы продемонстрировать сценарий с несколькими листами (данные на одном листе, а результат на другом)? Я пробовал это с Multi-sheet, и я не мог этого сделать. Было бы здорово, если бы вы могли помочь? Спасибо - person Manny; 08.07.2021
comment
это то, что я добавил в ваш код. Set ws = Sheets(Sheet1) Set rng = ws.Range(A1).CurrentRegion n = rng.Rows.Count - 1 Set rng = rng.Offset(1, 0).Resize(n) 'исключить заголовки Set ws2 = Sheets (Лист2) Установить rng2 = ws2.Range(A1).CurrentRegion n2 = rng2.Rows.Count - 1 Установить rng2 = rng2.Offset(1, 0).Resize(n2) 'исключить заголовки - person Manny; 08.07.2021
comment
Пока он вставлял результаты в Sheet2, сумматоры не использовали значения столбца в Sheet2, а использовали их только из Sheet1. Как мне это изменить? Спасибо - person Manny; 08.07.2021
comment
Пожалуйста, опубликуйте новый вопрос и включите свой полный код и ссылку на этот пост. Я посмотрю. Невозможно легко просмотреть код, размещенный в комментарии. - person Tim Williams; 08.07.2021