Sử dụng mảng tính Minifs và Maxifs với dữ liệu lớn

Chia sẻ bởi:hands

★★★★★

‹ Hỏi cách so sánh 2 range bất... Nhờ các bác hỗ trợ giải thuật... ›

Quảng cáo

Em chào anh/chị!
Em đang có 1 file khá nhiều dữ liệu, em đang muốn lấy dữ liệu từ sheet "Data" sang sheet1 với những dữ liệu muốn lấy như sau:
– Tính ngày mua đầu tiên của KH: với 3 điều kiện: Mã cửa hàng, mã khách hàng và thời gian nhỏ hơn tháng 4/2022
– Tính ngày mua cuối cùng của KH: với 3 điều kiện: Mã cửa hàng, mã khách hàng và thời gian nhỏ hơn tháng 4/2022
– Đếm ngày: Ngày cuối – Ngày đầu
Do dữ liệu nhiều nên em đang sử dụng hàm và code (Minifs và Maxifs) của em chạy bị treo máy.
Nên nhờ anh/chị hỗ trợ code mảng để có thể chạy hiệu quả hơn.
Em cảm ơn!
file: docs.google.com/spreadsheets/d/1dc7UPfJMEOHQtQaPP0F1pA8Pb5F7jIzy/edit?usp=sharing&ouid=106960914218320658553&rtpof=true&sd=true
Đây là code em đang viết:
Sub DEMNGAY()
Dim i As Long
Dim lr As Long
lr = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lr
   Sheet2.Range("D" & i) = Application.WorksheetFunction.MinIfs(Sheet1.Range("C:C"), Sheet1.Range("A:A"), Sheet2.Range("B" & i), Sheet1.Range("E:E"), "<=01/07/2022", Sheet1.Range("c:c"), Sheet2.Range("D" & i))
   Sheet2.Range("E" & i) = Application.WorksheetFunction.MaxIfs(Sheet1.Range("C:C"), Sheet1.Range("A:A"), Sheet2.Range("B" & i), Sheet1.Range("E:E"), "<=01/07/2022", Sheet1.Range("c:c"), Sheet2.Range("D" & i))
   Sheet2.Range("F" & i) = Sheet2.Range("G" & i) - Sheet2.Range("F" & i)
Next i
End Sub

Kiểm tra lại . . .

Option Explicit
Sub ABC()
  Dim arr(), aData(), res(), S, dic As Object, key$
  Dim tmp$, dk As Date, ngay As Date, srData&, srRes&, i&, k&
  With Sheets("Data")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
    aData = .Range("A2:C" & i).Value
  End With
  With Sheets("Sheet1")
    On Error Resume Next
    S = Split(.Range("A1").Value, " ")
    S = Split(S(UBound(S)), "/")
    dk = DateValue(S(1) & "/" & S(0) & "/1")
    If Err.Number > 0 Then MsgBox ("Nhap lai cell A1 theo dung mau!"): Exit Sub
    On Error GoTo 0
    i = .Range("B" & Rows.Count).End(xlUp).Row
    If i < 2 Then MsgBox ("Khong co du lieu!"): Exit Sub
    arr = .Range("B2:C" & i).Value
  End With
  srData = UBound(aData): srRes = UBound(arr)
  ReDim res(1 To srRes, 1 To 3)
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To srRes
    dic(arr(i, 1) & "|" & arr(i, 2)) = i
  Next i
  For i = 1 To srData
    ngay = aData(i, 3)
    If ngay < dk Then
      key = aData(i, 1) & "|" & aData(i, 2)
      If dic.exists(key) Then
        k = dic(key)
        If res(k, 1) > ngay Then
          res(k, 1) = ngay
        ElseIf res(k, 1) = Empty Then
          res(k, 1) = ngay
        End If
        If res(k, 2) < ngay Then res(k, 2) = ngay
      End If
    End If
  Next i
  For i = 1 To srRes
    If res(i, 1) <> Empty Then res(i, 3) = res(i, 2) - res(i, 1)
  Next i
  Sheets("Sheet1").Range("D2").Resize(srRes, 3) = res
End Sub

www.giaiphapexcel.com/diendan/threads/s%E1%BB%AD-d%E1%BB%A5ng-m%E1%BA%A3ng-t%C3%ADnh-minifs-v%C3%A0-maxifs-v%E1%BB%9Bi-d%E1%BB%AF-li%E1%BB%87u-l%E1%BB%9Bn.162193/#post-1082830