Sắp xếp báo cáo tổng hợp

Liên hệ QC

quanghn81

Thành viên mới
Tham gia
20/3/08
Bài viết
25
Được thích
2
Chào tất cả các bạn. Mình có 1 file gửi lên nhờ các bạn giúp mình với. Tức là mình muốn tạo một mẫu báo cáo được lấy DL từ Bảng Data. nhưng khi sắp xếp qua ben bảng tổng hợp thì dữ liệu được sắp xếp lại được liền nhau. Mình nhờ các bạn viết đoạn mã trong VBA vì dữ liệu của mình nhiều nên nếu dùng công thức thì file chạy rất chậm. Mình đã trình bày rõ ràng trong file của mình. Nhờ các bạn giúp mình.
 

File đính kèm

Hướng dẫn sử dụng khi dùng:

1*/ Vì trong VBA mình chưa oánh tiếng Việt được, nên trưng thu 2 cells E1 & F1 để hiện chuỗi bên báo cáo
2*/ Xem file đính kèm

PHP:
Option Explicit
Sub TongHopBH()
 Dim lRow As Long, RowB As Long, RowC As Long
 Dim Rng As Range:                      Dim StrC As String
 Dim SLuong As Double, TTien As Double
 
 Sheets("Data").Select
 [a1].Select:                           lRow = [A65432].End(xlUp).Row
 Sheets("TongHop").Range("A3:E" & lRow).Clear
 If Selection = "" Then
    Set Rng = Range("A1").End(xlDown)
 Else
    Set Rng = [a1]
 End If
 Do
    Set Rng = Rng.CurrentRegion:        StrC = Rng.Cells(1, 1)
    RowB = InStr(StrC, "nhân viên") + Len("nhân viên")
    StrC = "NV " & Mid(StrC, RowB)
    Set Rng = Rng.Cells(3, 1).Resize(Rng.Rows.Count - 2, Rng.Columns.Count)
    If Not Rng Is Nothing Then
        RowB = Sheets("TongHop").[A65432].End(xlUp).Row + 1
        Rng.Copy Destination:=Sheets("TongHop").Range("A" & RowB)
    Else
        Exit Do
    End If
23 ' Them Dong Cong'
    RowC = Sheets("TongHop").[A65432].End(xlUp).Row
    Sheets("TongHop").Cells(RowC + 1, 1) = [E1] & StrC
    FormatRegions Sheets("TongHop").Cells(RowC + 1, 1).Resize(1, 4)
    Sheets("TongHop").Cells(RowC + 1, 2).Formula = "=SUM(B" & RowB & ":B" & RowC & ")"
    SLuong = SLuong + Sheets("TongHop").Cells(RowC + 1, 2).Value
    Sheets("TongHop").Cells(RowC + 1, 4).Formula = "=SUM(d" & RowB & ":d" & RowC & ")"
    TTien = TTien + Sheets("TongHop").Cells(RowC + 1, 4).Value
    
30 ' Den Vung Moi'
    Set Rng = Rng.End(xlDown):          Set Rng = Rng.End(xlDown)
    If Rng.Cells(1, 1).Row > lRow Then Exit Do
 Loop
 
 With Sheets("TongHop").Cells(RowC + 2, 1)
    .Value = Sheets("Data").[F1]
    .Offset(, 1) = SLuong:              .Offset(, 3) = TTien
    FormatRegions .Resize(1, 4), True
 End With
End Sub


Mã:
Sub FormatRegions(Clls As Range, Optional Cuoi As Boolean = False)
  
 Clls.Font.ColorIndex = 3
 If Cuoi Then Clls.Font.Bold = True

End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
cám ơn bác Sa_QD, hướng dẫn của bạn cũng đả đúng ý của mình rồi, nhưng vì mình cũng mới làm quen với VBA nến cũng có những khó khăn, tiện đây bác có thể giải thích cho mình nhữg lệnh như [a1], [f1], [E1]...[a1].Select: lRow = [A65432].End(xlUp).Row
là gì không. Mình cũng chưa hiểu rõ cho lắm.
 
Upvote 0
Web KT

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

Back
Top Bottom