Code tạo báo cáo tổng hợp theo điều kiện

  • Thread starter Thread starter Nguoiay
  • Ngày gửi Ngày gửi
Liên hệ QC
Nguoiay

Nguoiay

Thành viên hoạt động
Tham gia
24/11/10
Bài viết
139
Được thích
34
Em đang tạo báo cáo tổng hợp bán hàng theo từng nhân viên theo ngày tháng phát sinh. Em loay hoay mãi không nghĩ ra cách xử lý nên đưa lên đây nhờ mọi người viết cho em đoạn code xử lý việc này.
Câu hỏi cụ thể ở file đính kèm.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nguoiay đã viết:
Em đang tạo báo cáo tổng hợp bán hàng theo từng nhân viên theo ngày tháng phát sinh. Em loay hoay mãi không nghĩ ra cách xử lý nên đưa lên đây nhờ mọi người viết cho em đoạn code xử lý việc này.
Câu hỏi cụ thể ở file đính kèm.
Nhấp chuột vào đây để mở rộng...
Bạn xem thử đúng ý mình chưa nhé.
 

File đính kèm

Upvote 0
Trễ chuyến rồi; Nhưng cũng cứ tham gia cho vui!
PHP: 
Sub TongHop()
 Dim Arr(), Sh As Worksheet, Cls As Range
 Dim Rws As Long, J As Long, W As Integer, fDat As Date, lDat As Date, SoLg As Double, Dg As Integer, Hg As Integer
 
 With Sheets("CSDL").[A2]
    Rws = .CurrentRegion.Rows.Count + 6
    Arr() = .Resize(Rws, 5).Value:          ReDim dArr(1 To Rws, 1 To 4)
 End With
 fDat = [F1].Value:                         lDat = [f2].Value
 On Error Resume Next
 For Each Cls In Range([N2], [N2].End(xlDown))
    W = W + 1:                              dArr(W + Dg, 1) = W
    dArr(W + Dg, 2) = Cls.Value:            Hg = W + Dg
    For J = 1 To UBound(Arr())
        If (Arr(J, 1) >= fDat And Arr(J, 1) <= lDat) And Arr(J, 2) = Cls.Value Then
            Dg = Dg + 1:                    SoLg = SoLg + Arr(J, 5)
            dArr(W + Dg, 3) = Arr(J, 3):    dArr(W + Dg, 4) = Arr(J, 5)
        End If
    Next J
    dArr(Hg, 4) = SoLg:                      SoLg = 0
 Next Cls
 [A7].Resize(W + Dg, 4).Value = dArr()
 Randomize:                                 [A6].Resize(, 4).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub
 

File đính kèm

Upvote 0
Theo quan điểm của mình thì về báo cáo nên sử dụng Pivot table hơn là sử dụng code, nếu phải code thì code để tạo các báo cáo tự động dựa vào pivot table, cho tiện việc xem với trích xuất dữ liệu thôi. Bạn nên tìm hiểu về Pivot table để sau này có thể chủ động hơn trong việc tạo các báo cáo khác nữa.
 
Upvote 0
Em xem cả 2 bài của anh @giaiphap và @SA_DQ định áp dụng vào file của em nhưng không làm được ạ. Liên quan đến code mảng này em kém quá ạ. Nên đành đưa file lên đây nhờ mọi người hỗ trợ cho em.
Dựa vào sheet Data để tạo báo cáo ở sheet REPORT_NV. Cách làm tương tự (giống cấu trúc) như file demo trên của em.
Nhờ mọi người giúp em với ạ!
Cám ơn mọi người nhiều!
 

File đính kèm

Upvote 0
Cột [Mã NV] của trang 'Data' là cột nào vậy bạn?
 
Upvote 0
SA_DQ đã viết:
Trễ chuyến rồi; Nhưng cũng cứ tham gia cho vui!
PHP: 
Sub TongHop()
Dim Arr(), Sh As Worksheet, Cls As Range
Dim Rws As Long, J As Long, W As Integer, fDat As Date, lDat As Date, SoLg As Double, Dg As Integer, Hg As Integer

With Sheets("CSDL").[A2]
    Rws = .CurrentRegion.Rows.Count + 6
    Arr() = .Resize(Rws, 5).Value:          ReDim dArr(1 To Rws, 1 To 4)
End With
fDat = [F1].Value:                         lDat = [f2].Value
On Error Resume Next
For Each Cls In Range([N2], [N2].End(xlDown))
    W = W + 1:                              dArr(W + Dg, 1) = W
    dArr(W + Dg, 2) = Cls.Value:            Hg = W + Dg
    For J = 1 To UBound(Arr())
        If (Arr(J, 1) >= fDat And Arr(J, 1) <= lDat) And Arr(J, 2) = Cls.Value Then
            Dg = Dg + 1:                    SoLg = SoLg + Arr(J, 5)
            dArr(W + Dg, 3) = Arr(J, 3):    dArr(W + Dg, 4) = Arr(J, 5)
        End If
    Next J
    dArr(Hg, 4) = SoLg:                      SoLg = 0
Next Cls
[A7].Resize(W + Dg, 4).Value = dArr()
Randomize:                                 [A6].Resize(, 4).Interior.ColorIndex = 34 + 9 * Rnd() \ 1
End Sub
Nhấp chuột vào đây để mở rộng...
Cách viết của anh dễ hiểu quá ! cảm ơn anh !
 
Upvote 0
Nguoiay đã viết:
Em xem cả 2 bài của anh @giaiphap và @SA_DQ định áp dụng vào file của em nhưng không làm được ạ. Liên quan đến code mảng này em kém quá ạ. Nên đành đưa file lên đây nhờ mọi người hỗ trợ cho em.
Dựa vào sheet Data để tạo báo cáo ở sheet REPORT_NV. Cách làm tương tự (giống cấu trúc) như file demo trên của em.
Nhờ mọi người giúp em với ạ!
Cám ơn mọi người nhiều!
Nhấp chuột vào đây để mở rộng...
Mã hàng của bạn lấy từ cột nào vậy?
 
Upvote 0
songhovl201 đã viết:
Mình muốn xem code để học hỏi thêm (trên điện thoại không xem được), không biết bạn có thể post đoạn code lên giùm được không. Thân chào bạn.
Nhấp chuột vào đây để mở rộng...
Chưa biết file thế nào nên chưa viết code nhé bạn, khi nào có file mình viết code đưa lên cho.
 
Upvote 0
Nguoiay đã viết:
Em đã ghi chú ở sheet Data ạ.
Link tải file sửa: https://drive.google.com/open?id=1KMTm6f82_fC1FNKy5ywT1JP0oOmjbUDx
Nhấp chuột vào đây để mở rộng...
Cột F ở sheet Data của bạn tại sao lại có ô trống? Với dữ liệu kiểu này thì code chạy không chính xác nhé.
Mã: 
Sub GPE()
Dim Arr(), dArr(), i As Long, tu As Date, den As Date, k As Long, Ma As String, Cs As String
Dim Rng As Range
    With Sheets("Data")
        i = .Range("S65000").End(xlUp).Row
        If i < 4 Then i = 4
        Arr = .Range("A4:S" & i).Value
    End With
    With Sheets("REPORT_NV")
        ReDim dArr(1 To UBound(Arr), 1 To 4)
        tu = .[F1]: den = .[F2]: Cs = .[F3]
        For i = 1 To UBound(Arr)
            If (Arr(i, 4) >= tu) And (Arr(i, 4) <= den) And (Arr(i, 19) = Cs) Then
                k = k + 1
                dArr(k, 2) = Arr(i, 6): dArr(k, 3) = Arr(i, 8): dArr(k, 4) = Arr(i, 12)
            End If
        Next i
        If k Then
            .Range("A8").Resize(k, 4) = dArr
            .Range("A8").Resize(k, 4).Sort key1:=Range("B8")
            dArr = .Range("A8").Resize(k, 4).Value
            k = 1: Ma = dArr(1, 2): dArr(1, 1) = k
            For i = 2 To UBound(dArr)
                If dArr(i, 2) = Ma Then
                    dArr(i, 2) = ""
                Else
                    Ma = dArr(i, 2)
                    k = k + 1: dArr(i, 1) = k
                End If
            Next i
                .Range("A7").Resize(UBound(dArr) + 1, 4).ClearFormats
                .Range("A8:D" & .Range("C65000").End(xlUp).Row).Clear
                .Range("A8").Resize(UBound(dArr), 4) = dArr
                k = UBound(dArr)
                For Each Rng In .Range("A8").Resize(UBound(dArr)).SpecialCells(xlCellTypeConstants)
                    Rows(Rng.Row & ":" & Rng.Row).Insert Shift:=xlDown
                    Rng.Offset(-1).Resize(, 2).Value = Rng.Resize(, 2).Value
                    Rng.Offset(-1).Resize(, 4).Font.Bold = True
                    Rng.Resize(, 2).Value = ""
                    k = k + 1
                Next Rng
                For Each Rng In .Range("D8").Resize(k).SpecialCells(xlCellTypeConstants).Areas
                    .Range("D" & Rng.Row - 1).FormulaR1C1 = "=SUM(R[1]C:R[" & Rng.Cells.Count & "]C)"
                Next Rng
                .Range("A7:D7").Font.Bold = True
                .Range("A7:D7").Interior.ThemeColor = xlThemeColorAccent1
                .Range("A7:D7").HorizontalAlignment = xlCenter
                .Range("A7:D7").Font.ThemeColor = xlThemeColorDark1
                .Range("A7").Resize(k + 1, 4).Borders.LineStyle = 1
        End If
    End With
MsgBox "Da thuc hien xong! .::(^v^)::.", vbExclamation, "---GPE---"
End Sub
Nếu ô trống chính là mã phía liền trên nó thì sửa lại thành code này.
Mã: 
Sub GPE()
Dim Arr(), dArr(), i As Long, tu As Date, den As Date, k As Long, Ma As String, Cs As String
Dim Rng As Range
    With Sheets("Data")
        i = .Range("S65000").End(xlUp).Row
        If i < 4 Then i = 4
        Arr = .Range("A4:S" & i).Value
    End With
    With Sheets("REPORT_NV")
        ReDim dArr(1 To UBound(Arr), 1 To 4)
        tu = .[F1]: den = .[F2]: Cs = .[F3]
        For i = 1 To UBound(Arr)
            If (Arr(i, 4) >= tu) And (Arr(i, 4) <= den) And (Arr(i, 19) = Cs) Then
                k = k + 1
                If Arr(i, 6) <> "" Then Ma = Arr(i, 6)
                dArr(k, 2) = Ma: dArr(k, 3) = Arr(i, 8): dArr(k, 4) = Arr(i, 12)
            End If
        Next i
        If k Then
            .Range("A8").Resize(k, 4) = dArr
            .Range("A8").Resize(k, 4).Sort key1:=Range("B8")
            dArr = .Range("A8").Resize(k, 4).Value
            k = 1: Ma = dArr(1, 2): dArr(1, 1) = k
            For i = 2 To UBound(dArr)
                If dArr(i, 2) = Ma Then
                    dArr(i, 2) = ""
                Else
                    Ma = dArr(i, 2)
                    k = k + 1: dArr(i, 1) = k
                End If
            Next i
                .Range("A7").Resize(UBound(dArr) + 1, 4).ClearFormats
                .Range("A8:D" & .Range("C65000").End(xlUp).Row).Clear
                .Range("A8").Resize(UBound(dArr), 4) = dArr
                k = UBound(dArr)
                For Each Rng In .Range("A8").Resize(UBound(dArr)).SpecialCells(xlCellTypeConstants)
                    Rows(Rng.Row & ":" & Rng.Row).Insert Shift:=xlDown
                    Rng.Offset(-1).Resize(, 2).Value = Rng.Resize(, 2).Value
                    Rng.Offset(-1).Resize(, 4).Font.Bold = True
                    Rng.Resize(, 2).Value = ""
                    k = k + 1
                Next Rng
                For Each Rng In .Range("D8").Resize(k).SpecialCells(xlCellTypeConstants).Areas
                    .Range("D" & Rng.Row - 1).FormulaR1C1 = "=SUM(R[1]C:R[" & Rng.Cells.Count & "]C)"
                Next Rng
                .Range("A7:D7").Font.Bold = True
                .Range("A7:D7").Interior.ThemeColor = xlThemeColorAccent1
                .Range("A7:D7").HorizontalAlignment = xlCenter
                .Range("A7:D7").Font.ThemeColor = xlThemeColorDark1
                .Range("A7").Resize(k + 1, 4).Borders.LineStyle = 1
        End If
    End With
MsgBox "Da thuc hien xong! .::(^v^)::.", vbExclamation, "---GPE---"
End Sub
 

File đính kèm

Upvote 0
Nguoiay đã viết:
Em đã ghi chú ở sheet Data ạ.
Link tải file sửa: https://drive.google.com/open?id=1KMTm6f82_fC1FNKy5ywT1JP0oOmjbUDx
Nhấp chuột vào đây để mở rộng...
Bạn sửa code lại thế này để tính tổng các mã hàng bị trùng.
Mã: 
Sub GPE()
Dim Arr(), dArr(), i As Long, tu As Date, den As Date, k As Long, Ma As String, Cs As String
Dim Rng As Range, Dic As Object
    With Sheets("Data")
        i = .Range("S65000").End(xlUp).Row
        If i < 4 Then i = 4
        Arr = .Range("A4:S" & i).Value
    End With
    With Sheets("REPORT_NV")
        ReDim dArr(1 To UBound(Arr), 1 To 4)
        tu = .[F1]: den = .[F2]: Cs = .[F3]
        Set Dic = CreateObject("Scripting.Dictionary")
        With Dic
            For i = 1 To UBound(Arr)
                If (Arr(i, 4) >= tu) And (Arr(i, 4) <= den) And (Arr(i, 19) = Cs) Then
                    Tmp = Arr(i, 6) & " - " & Arr(i, 8)
                    If Not .Exists(Tmp) Then
                        k = k + 1
                        .Add Tmp, k
                        dArr(k, 2) = Arr(i, 6): dArr(k, 3) = Arr(i, 8): dArr(k, 4) = Arr(i, 12)
                    Else
                        dArr(.Item(Tmp), 4) = dArr(.Item(Tmp), 4) + Arr(i, 12)
                    End If
                End If
            Next i
        End With
        Set Dic = Nothing
        If k Then
            .Range("A8").Resize(k, 4) = dArr
            .Range("A8").Resize(k, 4).Sort key1:=Range("B8")
            dArr = .Range("A8").Resize(k, 4).Value
            k = 1: Ma = dArr(1, 2): dArr(1, 1) = k
            For i = 2 To UBound(dArr)
                If dArr(i, 2) = Ma Then
                    dArr(i, 2) = ""
                Else
                    Ma = dArr(i, 2)
                    k = k + 1: dArr(i, 1) = k
                End If
            Next i
                .Range("A7").Resize(UBound(dArr) + 1, 4).ClearFormats
                .Range("A8:D" & .Range("C65000").End(xlUp).Row).Clear
                .Range("A8").Resize(UBound(dArr), 4) = dArr
                k = UBound(dArr)
                For Each Rng In .Range("A8").Resize(UBound(dArr)).SpecialCells(xlCellTypeConstants)
                    Rows(Rng.Row & ":" & Rng.Row).Insert Shift:=xlDown
                    Rng.Offset(-1).Resize(, 2).Value = Rng.Resize(, 2).Value
                    Rng.Offset(-1).Resize(, 4).Font.Bold = True
                    Rng.Resize(, 2).Value = ""
                    k = k + 1
                Next Rng
                For Each Rng In .Range("D8").Resize(k).SpecialCells(xlCellTypeConstants).Areas
                    .Range("D" & Rng.Row - 1).FormulaR1C1 = "=SUM(R[1]C:R[" & Rng.Cells.Count & "]C)"
                Next Rng
                .Range("A7:D7").Font.Bold = True
                .Range("A7:D7").Interior.ThemeColor = xlThemeColorAccent1
                .Range("A7:D7").HorizontalAlignment = xlCenter
                .Range("A7:D7").Font.ThemeColor = xlThemeColorDark1
                .Range("A7").Resize(k + 1, 4).Borders.LineStyle = 1
        End If
    End With
MsgBox "Da thuc hien xong! .::(^v^)::.", vbExclamation, "---GPE---"
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

dangvandang
  • Question Question
Chia sẻ tích hợp trí tuệ nhân tạo (AI) vào excel
    • Thích
Trả lời
8
Đọc
2K
dangvandang
dangvandang
ankhanh2k2
sắp xếp dữ liệu chấm công
Trả lời
4
Đọc
65
DeTong
D
HeSanbi
  • Question Question
Công cụ tạo và chỉnh sửa Ribbon ngay trên Excel (Bản Việt hóa)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
10
Đọc
6K
HeSanbi
HeSanbi
S
  • Question Question
Nhờ Mọi người giúp đỡ gộp nhiều dòng thành 1 dòng nhiều cột trong Power Query.
Trả lời
2
Đọc
72
SteveNguyen1991
S
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
Trả lời
0
Đọc
36
PhanTuHuong
PhanTuHuong
N
  • Question Question
Xin code link dữ liệu VBA ạ !
Trả lời
1
Đọc
50
BuiQuangThuan
B
Đỗ Tú Anh
♪♫♪ ~ Thư Giãn Với Âm Nhạc ~ ♫♪♫
    • Thích
21 22 23
Trả lời
446
Đọc
11K
SA_DQ
SA_DQ
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
7
Đọc
365
trung_bhxh
T
toanthinh
Công thức tính tuổi âm lịch
Trả lời
3
Đọc
83
toanthinh
toanthinh
S
Cần hỗ trợ xử lý hiện ngày sản phẩm bằng VBA
Trả lời
0
Đọc
46
sonminhtran
S
nghiahandsome1995
  • Question Question
in đậm chuỗi văn bản bằng excel
Trả lời
7
Đọc
151
HeSanbi
HeSanbi
GPE-Trợ Lý
[GPE] TALK SHOW EXCEL TRONG SẢN XUẤT
    • Thích
Trả lời
2
Đọc
730
GPE-Trợ Lý
GPE-Trợ Lý
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
40
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
  • Question Question
Mong mọi người giúp đỡ em trường hợp này với ạ.
Trả lời
1
Đọc
106
thanhduybg92
T
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
1
Đọc
57
vn72259
V
giaiphap
Add-Ins cho Excel 2007 -2016 32bit và 64bit
    • Thích
    • Yêu thích
    • Ngạc nhiên
24 25 26
Trả lời
512
Đọc
192K
vn72259
V
HeSanbi
  • Đã giải quyết
ZaloExcel v2.94: Gửi tin nhắn, hình ảnh, bảng, biểu đồ, tập tin, tạo nhóm, thu thập tin nhắn
    • Thích
    • Cảm ơn
    • Yêu thích
2 3
Trả lời
56
Đọc
15K
HeSanbi
HeSanbi
quyenpv
Hỗ trợ công thức dò tìn Index, Match trong bảng dò tìm kết quả
Trả lời
5
Đọc
103
quyenpv
quyenpv
B
Suy nghĩ của tui
    • Thích
2 3 4
Trả lời
60
Đọc
7K
SA_DQ
SA_DQ
H
In các trang theo điều kiện
Trả lời
3
Đọc
61
HUONGHCKT
H
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW EXCEL TRONG SẢN XUẤT
Back
Top Bottom