Maneira mais rápida de usar Sumifs ()

Question

Tenho uma tarefa semanal em que preciso atualizar um relatório (atualmente, pouco mais de 50 mil linhas), que está crescendo cerca de 500 linhas a cada semana. Depois que os novos dados são adicionados manualmente, eu executo o código abaixo para fazer um Sumifs()resumo dos dados.

A estrutura de dados é: as colunas A a C são as colunas de critérios (numérico-alfanumérico), a coluna D tem a quantidade a somar (números inteiros). Os dados são contíguos. Minha macro coloca a Sumifs()fórmula na coluna E - sobrescrevendo o que está lá.

Minha pergunta é: essa tarefa pode ser feita mais rapidamente? Atualmente, levo pouco mais de um minuto para executar a macro, mas isso fica mais longo à medida que os dados aumentam.

Há muito neste site sobre como usar Arrays para fazer tarefas mais rapidamente, mas nenhum dos exemplos faz muito sentido para mim e eu preferiria não usá-los, se possível.

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

Answer 1

Aqui está outra maneira:

EDITAR - atualizado para adicionar "médias" e "sumifs" à minha versão inicial (equivocada) de "contagens" ...

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

Answer 2

@ RuthMac77 você deve ouvir o conselho de Chris Neilsen e pesquisar SO para possíveis soluções de array ou, alternativamente, fazer uma pesquisa no Google por tutoriais de array - há muitos disponíveis.

Dito isso, respondi a uma pergunta muito semelhante a esta há alguns anos aqui . Usando sua descrição, repliquei a estrutura de dados conforme você a descreveu com 50.000 linhas de dados. Testá-lo usando o código existente levou cerca de 55 segundos.

Usando o método concatenar / classificar / IF descrito abaixo, os mesmos dados levaram apenas 1,5 segundos para serem calculados. Copie o código em seu módulo e me diga como você o executou.

Option Explicit
Sub FasterThanSumIfs()
Application.ScreenUpdating = False

Dim LastRow As Long
LastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

'Step 1: Concatenate the 3 values to a single string then sort by that string
With Sheet1.Range("E2:E" & LastRow)
    .FormulaR1C1 = "=(RC1 & CHAR(32) & RC2 & CHAR(32) & RC3)"
    .Value = .Value
End With
Sheet1.Columns("A:E").Sort Key1:=Sheet1.Range("E2"), Order1:=xlAscending, Header:=xlYes
Sheet1.Sort.SortFields.Clear

'Step 2: calculate the sum range column where the concatenated values are the same
With Sheet1.Range("F2:F" & LastRow)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,RC4+R[-1]C6,RC4)"
    .Value = .Value
End With

'Step 3: sort by string then by summed values largest to smallest to
'place the largest values at the top of each concatenated values' 'list'
Sheet1.Columns("A:F").Sort Key1:=Range("E2"), Order1:=xlAscending, _
Key2:=Range("F2"), Order2:=xlDescending, Header:=xlYes
Sheet1.Sort.SortFields.Clear

'Step 4: Return the highest value for each concatenated string
With Sheet1.Range("G2:G" & LastRow)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,R[-1]C7,RC6)"
    .Value = .Value
End With

'Step 5: replace the concatenated string values in column E with
'the Sumifs() values from column G.  Column E now contains the correct Sumifs()
'values as if a Sumifs() formula had been used - only much quicker!

Sheet1.Range("G2:G" & LastRow).Copy Sheet1.Range("E2")
Sheet1.Range("F:G").Clear

Application.ScreenUpdating = True
End Sub