Tính tổng dữ liệu băng dictionary

[acca_hcm]

Hiện tại, em chạy được dữ liệu tinh tong bằng dictionary sheet "datachiphithang" cot B
"
Sub chiphiluyke()
Application.ScreenUpdating = False
Dim i As Long, k As Long, j As Long, lr As Long
Dim arr_n(), arr_d(), dic As Object
Dim t
t = Timer

lr = Sheet9.Range("A" & Rows.Count).End(xlUp).Row ' dong cuoi
Set dic = CreateObject("scripting.dictionary")
arr_n = Sheet9.Range("A3:AK" & lr) ' gan mang nguon du lieu
ReDim arr_d(1 To UBound(arr_n, 1), 1 To 2)
k = 0
For i = 1 To UBound(arr_n, 1)
If Not dic.exists(arr_n(i, 34)) Then
k = k + 1
dic.Add arr_n(i, 34), k
arr_d(k, 1) = arr_n(i, 34) ' bien
arr_d(k, 2) = arr_n(i, 33) ' so lieu can tinh tong

Else
j = dic.Item(arr_n(i, 34)) ' bien can tinh tong neu co
arr_d(j, 2) = arr_d(j, 2) + arr_n(i, 33)

End If
Next
Sheet6.Range("B1:B19").ClearContents ' xoa noi dung truoc khi dua ket qua ra
Sheet6.Range("A1").Resize(k, 2) = arr_d 'dua ket qua ra bang dich
Sheet6.Range("B1").Offset(k, 0).FormulaR1C1 = "=sum(R1C:R[-1]C)"
MsgBox Timer - t
Application.ScreenUpdating = True

End Sub"
Nhơ anh/chị xem va chinh lai code giup em 2 truong họp sau o sheet "datachiphithang" tai 2 cot i và cot j
Cot i: Tinh tong voi dieu kien cot H du lieu co dinh
cot j: tinh tong voi dieu kien cot h du lieu co dinh va dieu kien k1
Em cảm ơn anh,chị

 

[Hoàng Tuấn 868]

em chạy được dữ liệu tinh tong bằng dictionary sheet "datachiphithang" cot B

Nếu đã chạy được thì tự chỉnh sẽ nhanh hơn mà.

 

[acca_hcm]

Nếu đã chạy được thì tự chỉnh sẽ nhanh hơn mà.

dictionary em mới tìm hiểu và ứng dụng, nên vẫn cần anh,chị tiền bối chỉ thêm ạ

 

[VetMini]

Có hiểu được quái gì đâu mà bảo chỉnh.

bối: tiếng Việt là cướp sông
tiền bối là tiền của thằng cướp sông?

 

[Hoàng Tuấn 868]

cần anh,chị tiền bối chỉ thêm ạ

Vậy thì chờ ai tên là "tiền bối" đến giúp nhé, mình không phải là tiền bối nên không giúp được.

 

[acca_hcm]

Nhờ anh/chị xem và fix giúp em, cảm ơn anh/chị nhiều ạ

 

[DeTong]

Nhờ anh/chị xem và fix giúp em, cảm ơn anh/chị nhiều ạ

So sánh thêm diều kiện là tháng...

 

[bebo021999]

Nếu là dùng dic đúng nghĩa, khai thác key và item của nó:

Sub chiphiluyke()
Application.ScreenUpdating = False
Dim i As Long, k As Long, lr As Long, th As Double
Dim arr_n(), arr_d(), dic As Object, key
Dim t
t = Timer
lr = Sheet9.Range("A" & Rows.Count).End(xlUp).Row ' dong cuoi
Set dic = CreateObject("scripting.dictionary")
arr_n = Sheet9.Range("A3:AK" & lr) ' gan mang nguon du lieu
For i = 1 To UBound(arr_n, 1)
    th = IIf(Month(arr_n(i, 1)) = Range("K1").Value, arr_n(i, 33), 0) 'du lieu thang
    If Not dic.exists(arr_n(i, 34)) Then
        dic.Add arr_n(i, 34), arr_n(i, 33) & "|" & th ' tao item la chuoi "giatriLK|giatrithang"
    Else
        sp = Split(dic(arr_n(i, 34)), "|")
        dic(arr_n(i, 34)) = sp(0) + arr_n(i, 33) & "|" & sp(1) + th 'cong don chuoi "giatriLK|giatrithang"
    End If
Next
ReDim arr_d(1 To dic.Count, 1 To 3)
For Each key In dic.keys
    k = k + 1
    arr_d(k, 1) = key ' bien
    arr_d(k, 2) = Split(dic(key), "|")(0) ' tach thanh phân truoc dau |: so lieu Luy ke
    arr_d(k, 3) = Split(dic(key), "|")(1) ' tach thanh phân sau dau |:so lieu thang
Next
If k = 0 Then Exit Sub
Sheet6.Range("H2:J10000").ClearContents ' xoa noi dung truoc khi dua ket qua ra
Sheet6.Range("H2").Resize(k, 3) = arr_d 'dua ket qua ra bang dich
Sheet6.Range("I1").Offset(k + 1, 0).FormulaR1C1 = "=sum(R1C:R[-1]C)"
Sheet6.Range("J1").Offset(k + 1, 0).FormulaR1C1 = "=sum(R1C:R[-1]C)"
MsgBox Timer - t
Application.ScreenUpdating = True

End Sub

 

[HieuCD]

Hiện tại, em chạy được dữ liệu tinh tong bằng dictionary sheet "datachiphithang" cot B
"
Sub chiphiluyke()
Application.ScreenUpdating = False
Dim i As Long, k As Long, j As Long, lr As Long
Dim arr_n(), arr_d(), dic As Object
Dim t
t = Timer

lr = Sheet9.Range("A" & Rows.Count).End(xlUp).Row ' dong cuoi
Set dic = CreateObject("scripting.dictionary")
arr_n = Sheet9.Range("A3:AK" & lr) ' gan mang nguon du lieu
ReDim arr_d(1 To UBound(arr_n, 1), 1 To 2)
k = 0
For i = 1 To UBound(arr_n, 1)
If Not dic.exists(arr_n(i, 34)) Then
k = k + 1
dic.Add arr_n(i, 34), k
arr_d(k, 1) = arr_n(i, 34) ' bien
arr_d(k, 2) = arr_n(i, 33) ' so lieu can tinh tong

Else
j = dic.Item(arr_n(i, 34)) ' bien can tinh tong neu co
arr_d(j, 2) = arr_d(j, 2) + arr_n(i, 33)

End If
Next
Sheet6.Range("B1:B19").ClearContents ' xoa noi dung truoc khi dua ket qua ra
Sheet6.Range("A1").Resize(k, 2) = arr_d 'dua ket qua ra bang dich
Sheet6.Range("B1").Offset(k, 0).FormulaR1C1 = "=sum(R1C:R[-1]C)"
MsgBox Timer - t
Application.ScreenUpdating = True

End Sub"
Nhơ anh/chị xem va chinh lai code giup em 2 truong họp sau o sheet "datachiphithang" tai 2 cot i và cot j
Cot i: Tinh tong voi dieu kien cot H du lieu co dinh
cot j: tinh tong voi dieu kien cot h du lieu co dinh va dieu kien k1
Em cảm ơn anh,chị

Kiểm tra lại . . .

Sub chiphiluyke()
  Application.ScreenUpdating = False
  Dim sRow&, sr&, i&, k&, thang&
  Dim aCode(), arr(), res(), dic As Object

  Set dic = CreateObject("scripting.dictionary")
  thang = Sheet6.Range("K1").Value
  aCode = Sheet6.Range("H2", Sheet6.Range("H" & Rows.Count).End(xlUp)).Value  ' gan mang nguon du lieu
  sRow = UBound(aCode, 1)
  ReDim res(1 To sRow + 1, 1 To 2)
  For i = 1 To sRow
    If aCode(i, 1) <> Empty Then dic(aCode(i, 1)) = i
  Next i
 
  arr = Sheet9.Range("AG3", Sheet9.Range("AK" & Rows.Count).End(xlUp)).Value   ' gan mang nguon du lieu
  sr = UBound(arr, 1)
  For i = 1 To sr
    If dic.exists(arr(i, 2)) Then
      k = dic(arr(i, 2))
      res(k, 1) = res(k, 1) + arr(i, 1)
      If arr(i, 5) = thang Then res(k, 2) = res(k, 2) + arr(i, 1)
    End If
  Next i
  For i = 1 To sRow
    res(sRow + 1, 1) = res(sRow + 1, 1) + res(i, 1)
    res(sRow + 1, 2) = res(sRow + 1, 2) + res(i, 2)
  Next i
  Sheet6.Range("I2").Resize(sRow + 1, 2) = res
  Application.ScreenUpdating = True
End Sub