Nhờ giúp code VBA báo cáo

Liên hệ QC

babyheomoi

Thành viên thường trực
Tham gia
22/9/13
Bài viết
396
Được thích
91
Xin chào mọi người, em có vấn đề nhỏ cần mọi người hỗ trợ ạ!
Em có 1 cái file data, và cần lọc ra file báo cáo!
Chuyện là xài hàm cũng ổn, nhưng data lớn quá nên hay bi lag và treo máy (tầm 3000 dòng và 100 cột) - chắc máy em già rồi!
Mọi người giúp em code cho nhanh gọn được không ạ? Cơ bản data có các lưu ý như sau:
1. 1 Khách hàng có thể có nhiều hơn 1 công trình
2. Trong các công trình của 1 khách hàng có thể có hơn 1 một người quản lý
Em cám ơn trước ạ!
 

File đính kèm

  • GPE.xlsx
    13.1 KB · Đọc: 35
Trời. Lần đầu tiên thấy định nghĩa pơ-ro pơ-ro thế này. Code VBA pơ-ro hơn Pivot Table!
Đi nhờ xe Hyundai xịn hơn mua xe Mercedes tự lái lấy.
Dạ, không phải, ý em là cơ quan em nhiều người chưa biết VBA ạ, e muốn xài Vba cho nó mới xíu, còn pivot đã nhiều người biết, nhưng nói thật với em em cũng chưa tìm hiểu và rành hết về pivot @@ chứ ko phải ý bác nói đâu ạ!
Bài đã được tự động gộp:

Dạ, cái đó chắc nhanh quá em nhầm, thường 1 khách sẽ có nhiều công trình, chứ không có kiểu 1 công trình nhiều khách hàng
Cám ơn anh
Bài đã được tự động gộp:

Theo tôi thì có rất nhiều
Chỉ cần kéo thả mà không cần viết code kiết
Cho thống kê nhiều Tuỳ chọn tuỳ ý. Cái này code rất cực
Gôm nhóm nhanh gọn lẹ
Định dạng theo mong muốn đẹp đẽ
................ và còn nhiều cái khác nữa
Dạ, nói thật a xưa giờ chưa đụng nhiều pivot, chủ yếu kéo thả, riêng phần định dạng thì em siêu kém!
Nếu có thể, anh định dạng mẫu giúp em thật đẹp a nhé!E cám ơn!
Bài đã được tự động gộp:

Chủ kênh biết sử dụng PivotTable nhưng muốn viết dùn code nhấn nút cái là được PivotTable luôn cho nó khỏe (kéo kéo, thả thả hơi mệt).
Bác trêu em, kaka, thực ra e marco Pivot rồi refesh cũng được mà, nhưng nhìn nó sao sao ấy @@ nên mới nhờ anh em GPE cho em mở mang tí kiến thức!
Bài đã được tự động gộp:

Trong khi chờ các bạn khác hỗ trợ, thử dùng code này xem sao.
Code tổng hợp theo quản lý và khách hàng được nhập bằng tay vào ô B8 và B9 của Sh REPOST. Nếu để trống 1 trong 2 ô trên thì code sẽ tổng hợp theo điều kiện còn lại.
Lưu ý : Dữ liệu nhập vào 2 ô B8, B9 được phân cách nhau bằng dấu ", ".
Hãy thêm hoặc thay đổi dữ liệu và chạy thử xem. Kết quả trả về đang để ở ô J2 đến..... bạn có thể thay đổi. tôi tin là bạn có thể cải tiến được code này.

Sub TONGHOP()
Dim i&, j&, t&, Lr&, K&
Dim Arr(), KQ(), QL, KH
Dim DK, DK1
On Error Resume Next
With Sheets("DATA")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("B2:J" & Lr).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 8)
QLname = Sheets("REPORT").Cells(8, 2)
KHname = Sheets("REPORT").Cells(9, 2)
QL = Split(QLname, ","): KH = Split(KHname, ",")
Q = UBound(QL): K = UBound(KH):
If Q = -1 Then Q = 0
If K = -1 Then K = 0
For h = 0 To Q
For m = 0 To K
If Q = 0 Then
If KHname <> Empty Then DK = Trim(QLname) & Trim(KH(m))
Else
If KHname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
End If
If K = 0 Then
If QLname <> Empty Then DK = Trim(KHname) & Trim(KH(m))
Else
If QLname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
End If
If Q = 0 And K = 0 Then DK = Trim(QL(h)) & Trim(KH(m))

If KHname = Empty And QLname <> Empty Then DK = Trim(QL(h))
If QLname = Empty And KHname <> Empty Then DK = Trim(KH(m))
For i = 1 To UBound(Arr)
If QLname <> Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 3)) & Trim(Arr(i, 2))

If KHname = Empty And QLname <> Empty Then DK1 = Trim(Arr(i, 3)
If QLname = Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 2))
If DK1 = DK Then
t = t + 1
KQ(t, 1) = t: KQ(t, 2) = Arr(i, 3): KQ(t, 3) = Arr(i, 2)
For n = 5 To 9
KQ(t, n - 1) = Arr(i, n)
Next n
End If
Next i
Next m
Next h
If t Then
Sheet2.[J11].Resize(t + 10, 9).ClearContents
Sheet2.[J11].Resize(t, 8) = KQ
End If
MsgBox "XONG"
End Sub




Code viết lòng vòng, loằng ngoằng quá tự bản thân cảm nhận là như vậy, Mong các bạn ghé qua xem code và cho góp ý nhé. Trân trọng.
CODE chạy ok lắm bạn, cám ơn bạn nhé!
 
Lần chỉnh sửa cuối:
Upvote 0
Bài đã được tự động gộp:

Bác trêu em, kaka, thực ra e marco Pivot rồi refesh cũng được mà, nhưng nhìn nó sao sao ấy @@ nên mới nhờ anh em GPE cho em mở mang tí kiến thức!
Tôi nói thật đó chứ không có trêu đâu, tìm bài viết Theo dõi công văn đi và đến xem tôi sử dụng PivotTable như thế nào thì sẽ hiểu.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi nói thật đó chứ không có trêu đâu, tìm bài viết Theo dõi công công đi và đến xem tôi sử dụng PivotTable như thế nào thì sẽ hiểu.
Thiệt là có bài "Theo dõi công công" hả bác?
Tôi tìm hoài không thấy bài nào có tựa gần như vậy mà có dùng Pivot Table, bác cho xin cái link luôn đi!
 
Upvote 0
Thiệt là có bài "Theo dõi công công" hả bác?
Tôi tìm hoài không thấy bài nào có tựa gần như vậy mà có dùng Pivot Table, bác cho xin cái link luôn đi!
Công công đi đến thường là ở "hậu cung", toàn chỗ "đờn bà, con gái", làm sao công khai cái link được.
Híc!!!!!!!!!!!!!!!
 
Upvote 0
Thiệt là có bài "Theo dõi công công" hả bác?
Tôi tìm hoài không thấy bài nào có tựa gần như vậy mà có dùng Pivot Table, bác cho xin cái link luôn đi!
Thì suy luận đoạn sau sẽ rõ (công văn chứ không phải công công) não một đằng tay một nẽo, tôi gõ nhằm mà quyên kiểm tra thôi mà.
Code PivotTble đó cách đây hơn 10 năm rồi, nay code ngắn gọn và có khác hơn xưa.
 
Upvote 0
Trong khi chờ các bạn khác hỗ trợ, thử dùng code này xem sao.
Code tổng hợp theo quản lý và khách hàng được nhập bằng tay vào ô B8 và B9 của Sh REPOST. Nếu để trống 1 trong 2 ô trên thì code sẽ tổng hợp theo điều kiện còn lại.
Lưu ý : Dữ liệu nhập vào 2 ô B8, B9 được phân cách nhau bằng dấu ", ".
Hãy thêm hoặc thay đổi dữ liệu và chạy thử xem. Kết quả trả về đang để ở ô J2 đến..... bạn có thể thay đổi. tôi tin là bạn có thể cải tiến được code này.

Sub TONGHOP()
Dim i&, j&, t&, Lr&, K&
Dim Arr(), KQ(), QL, KH
Dim DK, DK1
On Error Resume Next
With Sheets("DATA")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("B2:J" & Lr).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 8)
QLname = Sheets("REPORT").Cells(8, 2)
KHname = Sheets("REPORT").Cells(9, 2)
QL = Split(QLname, ","): KH = Split(KHname, ",")
Q = UBound(QL): K = UBound(KH):
If Q = -1 Then Q = 0
If K = -1 Then K = 0
For h = 0 To Q
For m = 0 To K
If Q = 0 Then
If KHname <> Empty Then DK = Trim(QLname) & Trim(KH(m))
Else
If KHname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
End If
If K = 0 Then
If QLname <> Empty Then DK = Trim(KHname) & Trim(KH(m))
Else
If QLname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
End If
If Q = 0 And K = 0 Then DK = Trim(QL(h)) & Trim(KH(m))

If KHname = Empty And QLname <> Empty Then DK = Trim(QL(h))
If QLname = Empty And KHname <> Empty Then DK = Trim(KH(m))
For i = 1 To UBound(Arr)
If QLname <> Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 3)) & Trim(Arr(i, 2))

If KHname = Empty And QLname <> Empty Then DK1 = Trim(Arr(i, 3)
If QLname = Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 2))
If DK1 = DK Then
t = t + 1
KQ(t, 1) = t: KQ(t, 2) = Arr(i, 3): KQ(t, 3) = Arr(i, 2)
For n = 5 To 9
KQ(t, n - 1) = Arr(i, n)
Next n
End If
Next i
Next m
Next h
If t Then
Sheet2.[J11].Resize(t + 10, 9).ClearContents
Sheet2.[J11].Resize(t, 8) = KQ
End If
MsgBox "XONG"
End Sub




Code viết lòng vòng, loằng ngoằng quá tự bản thân cảm nhận là như vậy, Mong các bạn ghé qua xem code và cho góp ý nhé. Trân trọng.
Bạn ơi, giúp mình thêm tí nữa được không ạ? File bạn làm rất ok nếu trích xuất rồi, tuy nhiên mình cần thêm là: SUM luôn các ds từ 5-9 (giống như consolidate ấy) đối với từng kh và từng quản lý được ko ạ? Giống như hình mình úp ở đây là Sum các ô họ Vin Group của Qly Trương Quang Nhật...
Bài đã được tự động gộp:

Thì suy luận đoạn sau sẽ rõ (công văn chứ không phải công công) não một đằng tay một nẽo, tôi gõ nhằm mà quyên kiểm tra thôi mà.
Code PivotTble đó cách đây hơn 10 năm rồi, nay code ngắn gọn và có khác hơn xưa.
Dạ, bác còn code Pivot không share em nhé!
Em cám ơn
 

File đính kèm

  • HELP GPE.jpg
    HELP GPE.jpg
    66.1 KB · Đọc: 17
  • help 2.jpg
    help 2.jpg
    51.4 KB · Đọc: 11
Lần chỉnh sửa cuối:
Upvote 0
Bạn ơi, giúp mình thêm tí nữa được không ạ? File bạn làm rất ok nếu trích xuất rồi, tuy nhiên mình cần thêm là: SUM luôn các ds từ 5-9 (giống như consolidate ấy) đối với từng kh và từng quản lý được ko ạ? Giống như hình mình úp ở đây là Sum các ô họ Vin Group của Qly Trương Quang Nhật...

Bạn thay code này vào code cũ nhé. thêm dữ liệu và chạy thử.
Mã:
Sub TONGHOP()
Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
Dim i&, j&, t&, Lr&, K&
Dim Arr(), KQ(), QL, KH
Dim DK, DK1
On Error Resume Next
With Sheets("DATA")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("B2:J" & Lr).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 8)
QLname = Sheets("REPORT").Cells(8, 2)
KHname = Sheets("REPORT").Cells(9, 2)
QL = Split(QLname, ","): KH = Split(KHname, ",")
Q = UBound(QL): K = UBound(KH):
If Q = -1 Then Q = 0
If K = -1 Then K = 0
For h = 0 To Q
    For m = 0 To K
        If Q = 0 Then
            If KHname <> Empty Then DK = Trim(QLname) & Trim(KH(m))
        Else
            If KHname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
        End If
        If K = 0 Then
            If QLname <> Empty Then DK = Trim(KHname) & Trim(KH(m))
        Else
            If QLname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
        End If
            If Q = 0 And K = 0 Then DK = Trim(QL(h)) & Trim(KH(m))
            If KHname = Empty And QLname <> Empty Then DK = Trim(QL(h))
            If QLname = Empty And KHname <> Empty Then DK = Trim(KH(m))
    
        For i = 1 To UBound(Arr)
            If QLname <> Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 3)) & Trim(Arr(i, 2))
            If KHname = Empty And QLname <> Empty Then DK1 = Trim(Arr(i, 3))
            If QLname = Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 2))
            
            If DK1 = DK Then
                If Not dic.Exists(DK) Then
                    t = t + 1
                    dic.Add DK, t
                        KQ(t, 1) = t: KQ(t, 2) = Arr(i, 3): KQ(t, 3) = Arr(i, 2)
                    For n = 5 To 9
                        KQ(t, n - 1) = Arr(i, n)
                    Next n
                Else
                    j = dic.Item(DK)
                    For n = 5 To 9
                        KQ(j, n - 1) = KQ(j, n - 1) + Arr(i, n)
                    Next n
                End If
            End If
        Next i
    Next m
Next h
If t Then
Sheet2.[J11].Resize(t + 10, 9).ClearContents
Sheet2.[J11].Resize(t, 8) = KQ
End If
Set dic = Nothing
MsgBox "XONG"
End Sub
[code]
 

File đính kèm

  • GPE-BABYHEOMOI.xlsm
    29.8 KB · Đọc: 15
Upvote 0
Bạn thay code này vào code cũ nhé. thêm dữ liệu và chạy thử.
Mã:
Sub TONGHOP()
Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
Dim i&, j&, t&, Lr&, K&
Dim Arr(), KQ(), QL, KH
Dim DK, DK1
On Error Resume Next
With Sheets("DATA")
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range("B2:J" & Lr).Value
End With
ReDim KQ(1 To UBound(Arr), 1 To 8)
QLname = Sheets("REPORT").Cells(8, 2)
KHname = Sheets("REPORT").Cells(9, 2)
QL = Split(QLname, ","): KH = Split(KHname, ",")
Q = UBound(QL): K = UBound(KH):
If Q = -1 Then Q = 0
If K = -1 Then K = 0
For h = 0 To Q
    For m = 0 To K
        If Q = 0 Then
            If KHname <> Empty Then DK = Trim(QLname) & Trim(KH(m))
        Else
            If KHname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
        End If
        If K = 0 Then
            If QLname <> Empty Then DK = Trim(KHname) & Trim(KH(m))
        Else
            If QLname <> Empty Then DK = Trim(QL(h)) & Trim(KH(m))
        End If
            If Q = 0 And K = 0 Then DK = Trim(QL(h)) & Trim(KH(m))
            If KHname = Empty And QLname <> Empty Then DK = Trim(QL(h))
            If QLname = Empty And KHname <> Empty Then DK = Trim(KH(m))
   
        For i = 1 To UBound(Arr)
            If QLname <> Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 3)) & Trim(Arr(i, 2))
            If KHname = Empty And QLname <> Empty Then DK1 = Trim(Arr(i, 3))
            If QLname = Empty And KHname <> Empty Then DK1 = Trim(Arr(i, 2))
           
            If DK1 = DK Then
                If Not dic.Exists(DK) Then
                    t = t + 1
                    dic.Add DK, t
                        KQ(t, 1) = t: KQ(t, 2) = Arr(i, 3): KQ(t, 3) = Arr(i, 2)
                    For n = 5 To 9
                        KQ(t, n - 1) = Arr(i, n)
                    Next n
                Else
                    j = dic.Item(DK)
                    For n = 5 To 9
                        KQ(j, n - 1) = KQ(j, n - 1) + Arr(i, n)
                    Next n
                End If
            End If
        Next i
    Next m
Next h
If t Then
Sheet2.[J11].Resize(t + 10, 9).ClearContents
Sheet2.[J11].Resize(t, 8) = KQ
End If
Set dic = Nothing
MsgBox "XONG"
End Sub
[code]
Chạy code này nó ra lỗi chị ơi, có 1 dòng hiện ra thôi ạ!
 
Upvote 0

File đính kèm

  • PivotTable-Project.xlsx
    34.7 KB · Đọc: 7
Upvote 0
Chạy code này nó ra lỗi chị ơi, có 1 dòng hiện ra thôi ạ!
Bạn chạy thử file của mình chưa, mình chạy thử file gia định của bạn êm rồi mà. Kiểm tra lại dữ liệu đầu vào bạn nhé, vói lại lưu ý là các điều kiện phân cách nhau bằng dấu ", " ( phảy cách) nhé.
 
Upvote 0
Pivot table xử lý hầu hết các dữ liệu người dùng mong muốn
còn trang trí cho báo cáo thì là chuyện sau khi có được dữ liệu.Tôi đã sử dụng PIvot table hơn 10 năm thấy nó nhanh và chính xác .
 
Upvote 0
Pivot table xử lý hầu hết các dữ liệu người dùng mong muốn
còn trang trí cho báo cáo thì là chuyện sau khi có được dữ liệu.Tôi đã sử dụng PIvot table hơn 10 năm thấy nó nhanh và chính xác .
Pivot có nghĩa là "tổng theo, xếp theo (cái điểm xoay pivot)". Từ "theo" là keyword.

Khi sử dụng Pivot Table là ta cốt sử dụng sự linh động của tính chất các vật thể xoay vòng quanh trụ chống.

Khi sử dụng code, nghe thì ngon lành những thực ra code chung chung là hàng cứng, kết quả chết. Để có được sự linh đọng thì người code phải rất giỏi và rất giàu kinh nghiệm.
 
Upvote 0
Pivot có nghĩa là "tổng theo, xếp theo (cái điểm xoay pivot)". Từ "theo" là keyword.

Khi sử dụng Pivot Table là ta cốt sử dụng sự linh động của tính chất các vật thể xoay vòng quanh trụ chống.

Khi sử dụng code, nghe thì ngon lành những thực ra code chung chung là hàng cứng, kết quả chết. Để có được sự linh đọng thì người code phải rất giỏi và rất giàu kinh nghiệm.
thực ra chúng ta có thể viết code để điều khiển Pivot table. (làm biếng kéo thả) . nhưng để theo yêu cầu của người dùng thì 9 người 10 ý. vì thế nên VBA điều khiển pivot table chi sử dụng cho người cần đúng biểu mẫu họ cần chứ không thể viết sẳn được.
 
Upvote 0
thực ra chúng ta có thể viết code để điều khiển Pivot table. (làm biếng kéo thả) . nhưng để theo yêu cầu của người dùng thì 9 người 10 ý. vì thế nên VBA điều khiển pivot table chi sử dụng cho người cần đúng biểu mẫu họ cần chứ không thể viết sẳn được.
9 người 10 ý chính là lý do tại sao tôi nói cần "rất giỏi và rất giàu kinh nghiệm"
rất giàu kinh nghiệm để nói "ý của mấy người dở bẹt"
rất giỏi để người nghe chịu nghe và không phản đối.
 
Upvote 0
9 người 10 ý chính là lý do tại sao tôi nói cần "rất giỏi và rất giàu kinh nghiệm"
rất giàu kinh nghiệm để nói "ý của mấy người dở bẹt"
rất giỏi để người nghe chịu nghe và không phản đối.
Chết thật, bài 32 tôi viết "Dùng Pivot table thì cần gì code" liệu có bị liệt vào "rất giỏi và rất giàu kinh nghiệm" không nhỉ?
 
Upvote 0
Chết thật, bài 32 tôi viết "Dùng Pivot table thì cần gì code" liệu có bị liệt vào "rất giỏi và rất giàu kinh nghiệm" không nhỉ?
Bạn thuộc dạng "đờn gảy tai trâu". Người ta không hề để ý. (xem câu cuối bài #22, và câu đầu bài #27)
 
Upvote 0
Bạn chạy thử file của mình chưa, mình chạy thử file gia định của bạn êm rồi mà. Kiểm tra lại dữ liệu đầu vào bạn nhé, vói lại lưu ý là các điều kiện phân cách nhau bằng dấu ", " ( phảy cách) nhé.
e thử rồi bác, e gửi bác hình em test @@ hay do máy em nhỉ?
Bài đã được tự động gộp:

Chết thật, bài 32 tôi viết "Dùng Pivot table thì cần gì code" liệu có bị liệt vào "rất giỏi và rất giàu kinh nghiệm" không nhỉ?
Dạ, e đang tìm hiểu bài của bác xem có làm gì được không ạ!
https://www.giaiphapexcel.com/diend...ào-pivot-table-để-lập-báo-cáo-theo-mẫu.47222/
 

File đính kèm

  • help gpe.docx
    298.7 KB · Đọc: 5
Lần chỉnh sửa cuối:
Upvote 0
e thử rồi bác, e gửi bác hình em test @@ hay do máy em nhỉ?
Bài đã được tự động gộp:


Dạ, e đang tìm hiểu bài của bác xem có làm gì được không ạ!
https://www.giaiphapexcel.com/diendan/threads/Áp-dụng-vba-vào-pivot-table-để-lập-báo-cáo-theo-mẫu.47222/

Đúng rồi, Do cách thử của bạn , hoặc có thể tôi viết code không đúng ý định của bạn
1/Code 1 là tổng hợp toàn bộ những Điều kiện ở 2 ô B8,B9 cứ đúng ĐK là trả về kết quả. Như hình là bạn chỉ có chọn 1 QL C do vậy nó sẽ lấy tất cả QL C ở trong CSDL,
2/Còn code 2 là nó sẽ tổng hợp theo ĐK ở 2 ô trên. nếu chỉ có 1 QL C thì nó sẽ cộng Tất cả các dòng có C theo từng cột tương ứng với DS A, DS B.... Tongcong.Nếu là 2 QL (Vd: A, C) và 3 khách hàng (ví dụ PI PI, Vin Grup, HUNG NHAN,...) thì nó sẽ lọc ra A có mấy PI PI và công lại theo các cột DS A, Ds B ... tương ứng, lọc tiếp đến C cũng như vậy cho đến hết QL thì thôi.

Bây giờ bạn thử lại thế này: Ô B8 bạn nhập 1 hoặc 2 hoặc 3 QL (Vdu: A, B, C)
Ô B9 bạn nhập 1,2,3 4, 5 khách hàng và chạy thử code 2 xem kết quả.
 
Upvote 0
Web KT
Back
Top Bottom