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

Blue Softs Liên hệ QC

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,107
Được thích
31,903
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant

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 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: 2
Lần chỉnh sửa cuố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
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ả.
 

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
Đú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ả.
dạ vâng, em làm như anh nói thì đúng thế, nhưng cái kết quả em mong muốn là như trong hình đó a! Tức là ô b9 để rỗng thì vẫn lọc hết ra, nhưng sum mấy KH trùng nhau lại
Trên ảnh đầu là code 1, ảnh sau là code 2 mong muốn!
Em cám ơn
 

File đính kèm

  • hekp gpe.jpg
    hekp gpe.jpg
    56.4 KB · Đọc: 9

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
dạ vâng, em làm như anh nói thì đúng thế, nhưng cái kết quả em mong muốn là như trong hình đó a! Tức là ô b9 để rỗng thì vẫn lọc hết ra, nhưng sum mấy KH trùng nhau lại
Trên ảnh đầu là code 1, ảnh sau là code 2 mong muốn!
Em cám ơn

Không hiểu ý nên không gặp nhau tại một điểm.
Sửa lại code: Đưa vòng lặp For i lên đầu, và thêm ĐK khách hàng là từng dòng của Dữ liệu vào nếu tìm thấy QL.
Trường hợp B8 rỗng, B9 không rỗng thì bạn tính thế nào? cũng Sum lại những quản lý trùng nhau hay không? Trong code dưới đây mình đã làm là sum lại.

Thay code sau vào
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 i = 1 To UBound(Arr)
    For h = 0 To Q
        For m = 0 To K
            If Q = 0 Then
                If KHname <> Empty Then DK = Trim(Arr(i, 3)) & 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(Arr(i, 2))
            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)) & Trim(Arr(i, 2))
            If QLname = Empty And KHname <> Empty Then DK = Trim(Arr(i, 3)) & Trim(KH(m))
       
          DK1 = Trim(Arr(i, 3)) & 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
Next i

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]
 

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
Không hiểu ý nên không gặp nhau tại một điểm.
Sửa lại code: Đưa vòng lặp For i lên đầu, và thêm ĐK khách hàng là từng dòng của Dữ liệu vào nếu tìm thấy QL.
Trường hợp B8 rỗng, B9 không rỗng thì bạn tính thế nào? cũng Sum lại những quản lý trùng nhau hay không? Trong code dưới đây mình đã làm là sum lại.

Thay code sau vào
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 i = 1 To UBound(Arr)
    For h = 0 To Q
        For m = 0 To K
            If Q = 0 Then
                If KHname <> Empty Then DK = Trim(Arr(i, 3)) & 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(Arr(i, 2))
            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)) & Trim(Arr(i, 2))
            If QLname = Empty And KHname <> Empty Then DK = Trim(Arr(i, 3)) & Trim(KH(m))
      
          DK1 = Trim(Arr(i, 3)) & 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
Next i

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]
Dạ, quản lý thì ko sum, chỉ sum khách hàng thôi a, e đang thử lại code a! em cám ơn
 
Top Bottom