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ị
"
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ị