V/v tối ưu xử lý đoạn code

[tuanxitin]

Nhờ Anh/chị xem và tối ưu xử lý đoạn code này giúp em, code chạy hơi bị lâu
em cảm ơn ạ

 

[SA_DQ]

Bị lâu chắc vì bạn xài SUMIF() cả 1 cột của con người ta;
Bạn thử xác đeịnh các dòng cuối có dữ liệu & giới hạn vùng có phạm vi nhỏ nhất có thể
Thật ra mình cũng chả biết bạn viết Code để xử cho trang tính nào. . .

 

[bebo021999]

Code của bạn có 3 vấn đề, 2 lớn và 1 nhỏ
1- Vấn đề lớn:
Bạn lồng 2 vòng lặp vào nhau không cần thiết khiến tốc độ xử lý bị gấp lên nhiều lần

For i = 4 To 219
'For y = 4 To 219

=215*215 lần =46225 lần, trong khi chỉ cần 1 vòng lặp 215 lần

For i = 4 To 219

2- Vấn đề lớn 2: Bạn chạy 2 sub cho 2 sheet khác nhau, với cùng 1 cách xử lý là loop từng dòng trên sheet chính để cài SUMIF cho sheet kia.
Bạn chỉ cần ghép vào làm 1 là được

3- Vấn đề nhỏ: Sau khi bạn chạy xong hết các sub, cuối cùng bạn mới ON timer sau đó OFF nó để đọc thời gian, và nó luôn luôn =0
Do đó bạn phải ON nó ngày từ đầu sub, và đọc timer cuối sub

Tôi sẽ post ở đây 2 code: 1 là chỉnh sửa code cũ, và 1 là code mới hoàn toàn rút gọn, để bạn tham khảo

Option Explicit

Sub baocao()
Dim i As Long
Dim y As Long
Dim Tmr As Double
Tmr = Timer()
For i = 4 To 219
'For y = 4 To 219
With ThisWorkbook.Sheets("GL")
    Cells(i, 5) = WorksheetFunction.SumIfs(.Range("F:F"), .Range("i:i"), Cells(2, 5), .Range("a:a"), Cells(i, 1))
    Cells(i, 6) = WorksheetFunction.SumIfs(.Range("g:g"), .Range("i:i"), Cells(2, 5), .Range("a:a"), Cells(i, 1))
End With
'Next
Next
Call MINI
MsgBox Timer() - Tmr
End Sub
Sub MINI()
Dim i As Long
'Dim y As Long
For i = 4 To 219
'For y = 4 To 219
With ThisWorkbook.Sheets("MINI")
    Cells(i, 8) = WorksheetFunction.SumIfs(.Range("F:F"), .Range("a:a"), Cells(i, 1))
    Cells(i, 9) = WorksheetFunction.SumIfs(.Range("N:N"), .Range("a:a"), Cells(i, 1))
End With
'Next
Next
End Sub
Sub xoadulieu()
Range("E4:I219").ClearContents
Range("L4:M219").ClearContents
Range("P4:Q219").ClearContents
End Sub

Code mới

Option Explicit
Sub baocao()
Dim i&, GL As Worksheet, MN As Worksheet
Dim Tmr As Double
Tmr = Timer()
Set GL = Sheets("GL")
Set MN = Sheets("MINI")
For i = 4 To 219
    With WorksheetFunction
        Cells(i, 5) = .SumIfs(GL.Range("F:F"), GL.Range("i:i"), Cells(2, 5), GL.Range("a:a"), Cells(i, 1))
        Cells(i, 6) = .SumIfs(GL.Range("g:g"), GL.Range("i:i"), Cells(2, 5), GL.Range("a:a"), Cells(i, 1))
        Cells(i, 8) = .SumIfs(MN.Range("F:F"), MN.Range("a:a"), Cells(i, 1))
        Cells(i, 9) = .SumIfs(MN.Range("N:N"), MN.Range("a:a"), Cells(i, 1))
    End With
Next
MsgBox Timer() - Tmr
End Sub
Sub xoadulieu()
Range("E4:I219").ClearContents
Range("L4:M219").ClearContents
Range("P4:Q219").ClearContents
End Sub

 

[VetMini]

Code gọi thuộc tính định vị Range nhiều quá, 216 lần thay vì chỉ cần 1 lần Set range.
Mõi lần gọi, VBA phải tính lại con trỏ vào range.
For i = 4 To 219
With WorksheetFunction
Cells(i, 5) = .SumIfs(GL.Range("F:F"), GL.Range("i:i"), Cells(2, 5), GL.Range("a:a"), Cells(i, 1))

 

[huhumalu]

Dù gì cũng nên tìm dòng cuối chứ các anh nhỉ ?

Set GL = Sheets("GL")
lstRGL = GL.Range("A" & Rows.Count).End(xlUp).Row
...
Cells(i, 5) = .SumIfs(GL.Range("F2:F" & lstRGL), GL.Range("I2:I" & lstRGL), Cells(2, 5), GL.Range("A2:A" & lstRGL), Cells(i, 1))