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

Chia sẻ bởi:hands

★★★★★

‹ Em muốn gom dữ liệu từ 1... Hỏi về code Hide row ›

Quảng cáo

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!!!

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!!!

1. Muốn xài sumifs thì xài côt phụ tách Năm, Tháng ra. Hoặc có thể là từ ngày tới ngày để không cần tách cột phụ-> Sumifs chắc chắn nhẹ hơn Sumproduct
2. Bạn đặt name =OFFSET(DATA!$A$2,,,COUNTA(DATA!$A:$A)-1) -> tại sao lại cả cột A:A mà không phải là $A1$:$A$10000 -> khi dữ liệu nhiều hơn bạn có thể vào name chỉnh lại. Đừng phung phí bộ nhớ Ram của máy tính như vậy…

Bạn có biết excel cả hơn triệu dòng -> nó gấp mấy lần cái 10 ngàn dòng không???

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)

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