Cách nhanh hơn để sử dụng Sumifs ()

Question

Tôi có một nhiệm vụ hàng tuần trong đó tôi cần cập nhật một báo cáo (hiện chỉ hơn 50 nghìn hàng) đang tăng khoảng 500 hàng mỗi tuần. Sau khi dữ liệu mới được thêm theo cách thủ công, tôi chạy mã bên dưới để thực hiện Sumifs()tóm tắt dữ liệu.

Cấu trúc dữ liệu là: cột A đến C là cột tiêu chí (số-chữ-số), cột D có số lượng tính tổng (số nguyên). Dữ liệu liền kề. Macro của tôi đặt Sumifs()công thức vào cột E - ghi đè lên những gì ở đó.

Câu hỏi của tôi là: nhiệm vụ này có thể được thực hiện nhanh hơn không? Tôi hiện chỉ mất hơn một phút để chạy macro, nhưng điều này sẽ lâu hơn khi dữ liệu phát triển.

Có rất nhiều điều trên trang web này về việc sử dụng Mảng để thực hiện các tác vụ nhanh hơn, nhưng không có ví dụ nào có ý nghĩa với tôi và tôi không muốn sử dụng chúng nếu có thể.

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

Đây là một cách khác:

CHỈNH SỬA - đã cập nhật để thêm "Averageifs" và "sumifs" vào phiên bản "countifs" ban đầu (nhầm lẫn) của tôi ...

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, bạn nên lắng nghe lời khuyên của chris neilsen và tìm kiếm SO để tìm các giải pháp mảng khả thi, hoặc tìm kiếm trên Google các hướng dẫn về mảng - có rất nhiều thứ ở đó.

Phải nói rằng, tôi đã trả lời một câu hỏi rất giống câu hỏi này cách đây vài năm ở đây . Sử dụng mô tả của bạn, tôi đã sao chép cấu trúc dữ liệu như bạn đã mô tả với 50.000 hàng dữ liệu. Kiểm tra nó bằng cách sử dụng mã hiện có của bạn mất khoảng 55 giây.

Bằng cách sử dụng phương pháp nối / sắp xếp / IF được nêu bên dưới, dữ liệu tương tự chỉ mất 1,5 giây để tính toán. Sao chép mã vào mô-đun của bạn và cho tôi biết bạn làm thế nào với nó.

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