Code báo cáo thống kê

[bactu]

Hiện tại mình có file báo cáo thống kê đã lập bằng công thức.
Chắc do số liệu nhiều và công thức chưa được tốt nên file chạy rất chậm. Xin code để làm được báo cáo như file đính kèm. Dữ liệu dựa vào sheet DATA, làm báo cáo theo tháng. Tháng báo cáo thay đổi dựa vào ô A8 tại sheet BAOCAO. Số liệu thay đổi giữa các tháng từ ô J53 đến ô T6246.
Cảm ơn rất nhiều!!!

 

[bactu]

Nặng hay không do mình.
1. Sumproduct nặng -> chuyển qua Sumifs
2. Vùng cộng của bạn đâu hết 1 triệu dòng mà xài tận A:A -> tại sao không giới hạn lại tầm 10.000 dòng.

3. Vân vân... và vân vân....

1. E cũng đã thử chuyển qua SUMIFS mà không sửa được lỗi đoạn điều kiện YEAR(DATA) = YEAR($A$8) và MONTH(DATA) = MONTH($A$8).
2. Vùng dữ liệu của Em chỉ sử dụng đến dòng cuối bên sheet DATA (Em sử dụng name là DATA)

3. Còn gì khác nữa, nhờ Anh hướng dẫn để em khắc phục.

Cảm ơn nhiều!!!

 

[vodoi2x]

1. E cũng đã thử chuyển qua SUMIFS mà không sửa được lỗi đoạn điều kiện YEAR(DATA) = YEAR($A$8) và MONTH(DATA) = MONTH($A$8).
2. Vùng dữ liệu của Em chỉ sử dụng đến dòng cuối bên sheet DATA (Em sử dụng name là DATA)

3. Còn gì khác nữa, nhờ Anh hướng dẫn để em khắc phục.

Cảm ơn nhiều!!!

Sử dụng SUMIFS và
Như bài trên nói,
Và thêm không sử dụng hàm Month year, hay dùng điều kiện >=, <= của ngày trong tháng

 

[bactu]

Sử dụng SUMIFS và
Như bài trên nói,
Và thêm không sử dụng hàm Month year, hay dùng điều kiện >=, <= của ngày trong tháng

1. Sửa name DATA = OFFSET(DATA!$A$2,,,COUNTA(DATA!$A1:$A10000)-1)
2. Sửa điệu kiện YEAR(DATA) = YEAR($A$8) và MONTH(DATA) = MONTH($A$8) thành DATA,">="&DATE(YEAR($A$8),MONTH($A$8),1),DATA,"<="&DATE(YEAR($A$8),MONTH($A$8)+1,0)

 

[bactu]

Bạn chạy code sau. Tự kiểm tra lại xem. Tôi viết vội...

Option Explicit

Public Sub GPE_()
Dim Dic As Object, sArr, I As Long, Ngay As Date, Tem As String, Rw As Long, dArr, tArr, J As Long
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("DATA")
    sArr = .Range("A2", .Range("B" & Rows.Count).End(3)).Resize(, 8).Value
End With
Application.ScreenUpdating = False
'On Error Resume Next
With Sheets("BAOCAO")
    Ngay = [A8].Value2
   
    dArr = .Range("A55:T101").FormulaR1C1
    tArr = Array(10, 15, 20)
    For I = 1 To UBound(dArr)
        Tem = UCase(dArr(I, 2))
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, I
            End If
            For J = 0 To UBound(tArr)
                dArr(I, tArr(J)) = Empty
            Next
    Next
    For I = 1 To UBound(sArr)
        If Len(sArr(I, 1)) Then
            Tem = UCase(sArr(I, 2))
            If Dic.exists(Tem) Then
            Rw = Dic.Item(Tem)
                If Val(Format(Ngay, "yyyymm")) = Val(Format(sArr(I, 1), "yyyymm")) Then
                    dArr(Rw, 10) = dArr(Rw, 10) + sArr(I, 6)
                    dArr(Rw, 20) = dArr(Rw, 20) + sArr(I, 8)
                End If
                If Year(Ngay) = Val(Format(sArr(I, 1), "yyyy")) Then
                    dArr(Rw, 15) = dArr(Rw, 15) + sArr(I, 6)
                End If
            End If
           
        End If
    Next
    .Range("A55:T101").FormulaR1C1 = dArr
   
    dArr = .Range("A103:Z6246").FormulaR1C1
    tArr = Array(8, 10, 13, 15, 18, 20)
    For I = 1 To UBound(dArr)
        If dArr(I, 1) = Empty Then
            Tem = UCase(dArr(I, 25) & "#" & dArr(I, 26))
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, I
            End If
            For J = 0 To UBound(tArr)
                dArr(I, tArr(J)) = Empty
            Next
        End If
    Next
    For I = 1 To UBound(sArr)
        If Len(sArr(I, 1)) Then
            Tem = UCase(sArr(I, 3) & "#" & sArr(I, 2))
            If Dic.exists(Tem) Then
            Rw = Dic.Item(Tem)
                If Val(Format(Ngay, "yyyymm")) = Val(Format(sArr(I, 1), "yyyymm")) Then
                    dArr(Rw, 8) = dArr(Rw, 8) + sArr(I, 5)
                    dArr(Rw, 10) = dArr(Rw, 10) + sArr(I, 6)
                    dArr(Rw, 18) = dArr(Rw, 18) + sArr(I, 7)
                    dArr(Rw, 20) = dArr(Rw, 20) + sArr(I, 8)
                End If
                If Year(Ngay) = Val(Format(sArr(I, 1), "yyyy")) Then
                    dArr(Rw, 13) = dArr(Rw, 13) + sArr(I, 5)
                    dArr(Rw, 15) = dArr(Rw, 15) + sArr(I, 6)
                End If
            End If
           
        End If
    Next
    .Range("A103:Z6246").FormulaR1C1 = dArr
End With
Application.ScreenUpdating = True
Set Dic = Nothing
End Sub

Thật là tuyệt vời.
Cảm ơn Bác nhiều lắm!!!