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

Blue Softs Liên hệ QC

babyheomoi

Thành viên thường trực
Tham gia ngày
22 Tháng chín 2013
Bài viết
346
Được thích
76
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:

be_09

Biên Hòa, Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,797
Được thích
9,588
Nghề nghiệp
Công chức
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:

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,947
Được thích
2,110
Donate (Momo)
Donate
Giới tính
Nam
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!
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,979
Được thích
17,221
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!!!!!!!!!!!!!!!
 

be_09

Biên Hòa, Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,797
Được thích
9,588
Nghề nghiệp
Công chức
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.
 

babyheomoi

Thành viên thường trực
Tham gia ngày
22 Tháng chín 2013
Bài viết
346
Được thích
76
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: 10
  • help 2.jpg
    help 2.jpg
    51.4 KB · Đọc: 4
Lần chỉnh sửa cuối:

Mr_Fly

Thành viên mới
Tham gia ngày
3 Tháng sáu 2021
Bài viết
17
Được thích
1
có bạn nào ở đây biết lỗi sai của đoạn code này của mình không? chỉ giúp mình với.
Private Sub UserForm_Activate()
Dim lr1 As Long
Dim lr2 As Long
With Sheets("Source")
lr1 = .Range("A" & Rows.Count).End(xlUp).Row
arr1 = .Range("A3:B" & lr1).Value
lr2 = .Range("H" & Rows.Count).End(xlUp).Row
arr2 = .Range("H3:I" & lr2).Value
End With
Cbmacty.List = arr1
Cbmatinh.List = arr2

End Sub
hiện mình đang bị lỗi ở việc đẩy data từ 2 combobox vào 2 mảng riêng biệt là arr1 và arr2, cho dùng 2 mảng này mình đã khai báo Public từ đầu rồi.
 

HUONGHCKT

Thành viên hoạt động
Tham gia ngày
30 Tháng tám 2012
Bài viết
166
Được thích
214
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: 6

babyheomoi

Thành viên thường trực
Tham gia ngày
22 Tháng chín 2013
Bài viết
346
Được thích
76
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 ạ!
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
11,108
Được thích
31,904
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant

File đính kèm

  • PivotTable-Project.xlsx
    34.7 KB · Đọc: 2

HUONGHCKT

Thành viên hoạt động
Tham gia ngày
30 Tháng tám 2012
Bài viết
166
Được thích
214
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é.
 

Lê Duy Thương

CẠO LẤY GÌ GỘI ?
Tham gia ngày
14 Tháng mười 2009
Bài viết
3,083
Được thích
4,805
Giới tính
Nam
Nghề nghiệp
PLANNING MANAGER
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 .
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
12,002
Được thích
15,285
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.
 

Lê Duy Thương

CẠO LẤY GÌ GỘI ?
Tham gia ngày
14 Tháng mười 2009
Bài viết
3,083
Được thích
4,805
Giới tính
Nam
Nghề nghiệp
PLANNING MANAGER
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.
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
12,002
Được thích
15,285
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.
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
11,108
Được thích
31,904
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant
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ỉ?
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
12,002
Được thích
15,285
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)
 
Top Bottom