V/v code xử lý dữ liệu bị chậm

[tuanxitin]

Nhờ Anh/Chị xem lại đoạn code (module 4) sau giúp em, chạy hơi bị chậm khi xử lý cột "G" sheet "tanghanmuc 2024". em cảm ơn ạ

"
Sub tanghanmuc2024()
Dim shdata2024 As Worksheet
Dim i As Long
Dim y As Long
Dim lr As Long
Dim arr() As Long
Dim t
t = Timer
Set shdata2024 = ThisWorkbook.Sheets("data2024")

For i = 2 To 12098
With shdata2024
lr = .Range("AG" & Rows.Count).End(xlUp).Row


Cells(i, 7) = WorksheetFunction.SumIfs(.Range("AG3:AG" & lr), .Range("y3:y" & lr), Cells(i, 2), .Range("b3:b" & lr), Cells(i, 1))

End With
Next
MsgBox Timer - t


End Sub
Sub xoadulieu()
Range("G2:G12908").ClearContents

End Sub"

 

[BuiQuangThuan]

Nhờ Anh/Chị xem lại đoạn code (module 4) sau giúp em, chạy hơi bị chậm khi xử lý cột "G" sheet "tanghanmuc 2024". em cảm ơn ạ

"
Sub tanghanmuc2024()
Dim shdata2024 As Worksheet
Dim i As Long
Dim y As Long
Dim lr As Long
Dim arr() As Long
Dim t
t = Timer
Set shdata2024 = ThisWorkbook.Sheets("data2024")

For i = 2 To 12098
With shdata2024
lr = .Range("AG" & Rows.Count).End(xlUp).Row


Cells(i, 7) = WorksheetFunction.SumIfs(.Range("AG3:AG" & lr), .Range("y3:y" & lr), Cells(i, 2), .Range("b3:b" & lr), Cells(i, 1))

End With
Next
MsgBox Timer - t


End Sub
Sub xoadulieu()
Range("G2:G12908").ClearContents

End Sub"

Bạn dùng mảng. Tốc độ xử lý sẽ nhanh hơn nhiều

 

[Quang_Hải]

Nhờ Anh/Chị xem lại đoạn code (module 4) sau giúp em, chạy hơi bị chậm khi xử lý cột "G" sheet "tanghanmuc 2024". em cảm ơn ạ

"
Sub tanghanmuc2024()
Dim shdata2024 As Worksheet
Dim i As Long
Dim y As Long
Dim lr As Long
Dim arr() As Long
Dim t
t = Timer
Set shdata2024 = ThisWorkbook.Sheets("data2024")

For i = 2 To 12098
With shdata2024
lr = .Range("AG" & Rows.Count).End(xlUp).Row


Cells(i, 7) = WorksheetFunction.SumIfs(.Range("AG3:AG" & lr), .Range("y3:y" & lr), Cells(i, 2), .Range("b3:b" & lr), Cells(i, 1))

End With
Next
MsgBox Timer - t


End Sub
Sub xoadulieu()
Range("G2:G12908").ClearContents

End Sub"

Code này mà có chạy nhanh chắc cũng cho ra kết quả = 0 hết, vì cột điều kiện là cột B, giá trị so sánh nằm ở cột A thì sao cho kết quả được
".Range("b3:b" & lr), Cells(i, 1))"

 

[tuanxitin]

Code này mà có chạy nhanh chắc cũng cho ra kết quả = 0 hết, vì cột điều kiện là cột B, giá trị so sánh nằm ở cột A thì sao cho kết quả được
".Range("b3:b" & lr), Cells(i, 1))"

Cột B sheet "data2024", điều kiện Cột A sheet "tanghanmuc 2024" >>>nó khớp nhau á anh

 

[Quang_Hải]

Cột B sheet "data2024", điều kiện Cột A sheet "tanghanmuc 2024" >>>nó khớp nhau á anh

Code bạn viết sai nhiều lắm. Hay là bạn cứ làm 1 cái công thức thủ công, gởi file lại, mình sửa code cho. Đảm bảo chạy trong nháy mắt

 

[VetMini]

Một ngày chạy mấy lần mà phải tính chuyện nhanh với chậm?
Macro cỡ này cứ chạy đúng kết quả là được rồi. Để thì giờ và tâm não học những công cụ khác.

 

[tuanxitin]

Code bạn viết sai nhiều lắm. Hay là bạn cứ làm 1 cái công thức thủ công, gởi file lại, mình sửa code cho. Đảm bảo chạy trong nháy mắt

Em gửi lại Anh, anh xem giúp em cột G sheet "tanghanmuc 2024"
cảm ơn anh

 

[Quang_Hải]

Em gửi lại Anh, anh xem giúp em cột G sheet "tanghanmuc 2024"
cảm ơn anh

Code đây

Sub tanghanmuc2024()
Dim sArr(), dArr(), Res(), i As Long, tmp As String, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Data2024")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(3)).Resize(, 33).Value
End With
For i = 1 To UBound(sArr)
    tmp = sArr(i, 2) & "_" & sArr(i, 25)
    Dic(tmp) = Dic(tmp) + sArr(i, 33)
Next
With Sheets("TANGHANMUC2024")
    dArr = .Range("A2", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
End With
ReDim Res(1 To UBound(dArr), 1 To 1)
For i = 1 To UBound(dArr)
    tmp = dArr(i, 1) & "_" & dArr(i, 2)
    If Dic.exists(tmp) Then
        Res(i, 1) = Dic.Item(tmp)
    End If
Next
Sheets("TANGHANMUC2024").Range("G2").Resize(UBound(Res)) = Res
End Sub

 

[tuanxitin]

Code đây

Sub tanghanmuc2024()
Dim sArr(), dArr(), Res(), i As Long, tmp As String, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
With Sheets("Data2024")
    sArr = .Range("A3", .Range("A" & Rows.Count).End(3)).Resize(, 33).Value
End With
For i = 1 To UBound(sArr)
    tmp = sArr(i, 2) & "_" & sArr(i, 25)
    Dic(tmp) = Dic(tmp) + sArr(i, 33)
Next
With Sheets("TANGHANMUC2024")
    dArr = .Range("A2", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
End With
ReDim Res(1 To UBound(dArr), 1 To 1)
For i = 1 To UBound(dArr)
    tmp = dArr(i, 1) & "_" & dArr(i, 2)
    If Dic.exists(tmp) Then
        Res(i, 1) = Dic.Item(tmp)
    End If
Next
Sheets("TANGHANMUC2024").Range("G2").Resize(UBound(Res)) = Res
End Sub

em cảm ơn anh nhiều ạ