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

anhbanvuitinh9x · 26/9/22

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: https://docs.google.com/spreadsheet...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

anhbanvuitinh9x · 27/9/22

HieuCD đã viết:

Kiểm tra lại . . .

Mã:

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

Em test thử rồi chạy rất nhanh bác à. 1 lần nữa em xin chân thành cảm ơn!

Bài đã được tự động gộp: 27/9/22

VetMini đã viết:
Bạn có vấn đề về cách đọc bài của người khác.
Bạn khong phân biệt được "hỏi bài" và tranh luận".

Đáng lẽ tôi làm nngow vì mục đích tôi đã xong rồi. Nhưng baiof trước tôi quên cảm ơn bạn đã tạo bài học cho hiojc trò tôi. Cho nên lần này tôi chỉ cho bạn những điều dưới đây coi như cảm ơn.

Đọc kỹ lại đi. Tôi có nói rõ là "tranh luận" vô ích. Thì giờ than là không đủ học mà ở đấy lo tranh luận.
Tôi cũng có chỉ rõ ra là chú tâm vào cái người ở bài #13. Người ta cần hỏi lại mà bạn trả lời quá vắn tắt. Chịu khó để tâm trí vào "tại sao ngwoif ta hỏi vậy?", và mình đã "diễn tả hết vấn đề chưa?"
Ở trên tôi có bôi đậm, tô đỏ điểm này mà bạn đang lên cơn tự ái, để cho mờ lý trí.

ok bác.
bài toán của em được giải quyết rồi nên em cũng không "hỏi bài" bác nữa tránh mất thời gian của bác.
Em cảm ơn bác đã quan tâm tới bài của em.

BuiQuangThuan · 27/9/22

Thêm 1 cách khác sử dụng nền Code của Thầy @HieuCD. Tập tọe code xíu.

Mã:

Sub XYZ()
  Dim arr(), aData(), res(), S, dic As Object, key$
  Dim tmp$, dk As Date, ngay As Date, srData&, srRes&, i&, k&, S1
  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 UBound(aData)
    If aData(i, 3) < dk Then
        dic(aData(i, 1) & "|" & aData(i, 2)) = dic(aData(i, 1) & "|" & aData(i, 2)) & "," & i
    End If
  Next i
  For i = 1 To UBound(arr)
      key = arr(i, 1) & "|" & arr(i, 2)
      If dic.exists(key) = True Then
        S1 = Split(dic.Item(key), ",")
          res(i, 1) = aData(CLng(S1(1)), 3)
            If UBound(S1) > 1 Then
              res(i, 2) = aData(CLng(S1(UBound(S1))), 3)
            Else
              res(i, 2) = aData(CLng(S1(1)), 3)
            End If
          res(i, 3) = res(i, 2) - res(i, 1)
    End If
  Next i
  Sheets("Sheet1").Range("G2").Resize(srRes, 3) = res
End Sub

VetMini · 27/9/22

BuiQuangThuan đã viết:
Thêm 1 cách khác sử dụng nền Code của Thầy @HieuCD. Tập tọe code xíu.

Mã:

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

Code này chỉ bẫy được từ ngày 13 đến ngày 31. Khoảng 12 ngày còn lại (30%) nó cho qua.
Code mà không 100% thì hơi khó chấp nhận.

BuiQuangThuan · 27/9/22

VetMini đã viết:
Code này chỉ bẫy được từ ngày 13 đến ngày 31. Khoảng 12 ngày còn lại (30%) nó cho qua.
Code mà không 100% thì hơi khó chấp nhận.

Cháu đang cố gắng hình dung cái lỗi mà chú nói ( 12 ngày còn lại) . Mong chú chỉ điểm thêm.

Phuocam · 27/9/22

Thử thay DateValue() bằng DateSerial() xem sao.

VetMini · 27/9/22

BuiQuangThuan đã viết:
Cháu đang cố gắng hình dung cái lỗi mà chú nói ( 12 ngày còn lại) . Mong chú chỉ điểm thêm.

Code ấy bạn chuyển dạng từ dd/mm sang mm/dd (hay ngược lại, tùy hệ thống) phải không
Hàm DateValue có khả năng "tạm đoán dạng ngày theo hệ thống và đổi dạng nếu cần thiết".
Nếu bạn cho nó ngày "5/6/2022" thì nó đoán theo hệ thống của bạn. Tức là ở máy Âu châu, nó hiểu là ngày 5 tháng 6; nhưng ở máy Mẽo, nó hiểu là ngày 6 tháng 5.
Nếu bạn cho nó ngày "5/13/2022" thì máy nào cũng hiểu là ngày 13 tháng 5 -> nó tự đoán vì nó biết là không có tháng 13.

Dùng hàm DateSerial như bài #25 an toàn hơn.

BuiQuangThuan · 27/9/22

VetMini đã viết:
Code ấy bạn chuyển dạng từ dd/mm sang mm/dd (hay ngược lại, tùy hệ thống) phải không
Hàm DateValue có khả năng "tạm đoán dạng ngày theo hệ thống và đổi dạng nếu cần thiết".
Nếu bạn cho nó ngày "5/6/2022" thì nó đoán theo hệ thống của bạn. Tức là ở máy Âu châu, nó hiểu là ngày 5 tháng 6; nhưng ở máy Mẽo, nó hiểu là ngày 6 tháng 5.
Nếu bạn cho nó ngày "5/13/2022" thì máy nào cũng hiểu là ngày 13 tháng 5 -> nó tự đoán vfi nao biết ladf khong có

Dùng hàm DateSerial như bài #25 an toàn hơn.

Cám ơn chú và bài #25 ạ.

tranhungdao12a3 · 24/10/22

Những bài toán kiểu này phải dùng Power Pivot, Power bi chứ bạn: 10 triệu dòng rồi mà vẫn bám VBA à:
Ngaymuadau = CALCULATE(MIN('Tablerp'[Ngày tháng]),'Tablerp'[Ngày tháng]<date(2022,04,30))
Ngaymuacuoi = CALCULATE(max('Tablerp'[Ngày tháng]),'Tablerp'[Ngày tháng]<date(2022,04,30))
Khoảng thời gian = DATEDIFF([Ngaymuadau],[Ngaymuacuoi],DAY)
Số lần mua=distintcount('Tablerp'[Ngày tháng])

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

anhbanvuitinh9x

Thành viên mới

anhbanvuitinh9x

Thành viên mới

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

VetMini

Ăn cùng góc phố

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Phuocam

Thành viên mới

VetMini

Ăn cùng góc phố

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

tranhungdao12a3

Thành viên tiêu biểu

File đính kèm

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian