Lọc dữ liệu thành báo cáo thu gọn

[toangm]

Nhờ các anh chị giúp em code VBA để lọc dữ liệu từ một bảng theo IDSub rồi tạo thành báo cáo thu gọn bằng VBA với!

 

[HUONGHCKT]

Nhờ các anh chị giúp em code VBA để lọc dữ liệu từ một bảng theo IDSub rồi tạo thành báo cáo thu gọn bằng VBA với!View attachment 262547

Nếu còn quan tâm thì dùng thử đoạn code này.
các thủ tục gọi form, định dạng cell... tôi tin là bạn thừa sức làm được.

 

[toangm]

Nếu còn quan tâm thì dùng thử đoạn code này.

Em chạy code nếu thêm 5 mã IDSub giống nhau thì chương trình bị lỗi. Anh giúp em xử lý lỗi này với!

 

[HieuCD]

Em chạy code nếu thêm 5 mã IDSub giống nhau thì chương trình bị lỗi. Anh giúp em xử lý lỗi này với!View attachment 262587

Chỉnh code

Sub LOC()
  Dim Arr(), KQ(), aCol, idSub$, tong#, i&, j&, t&
 
  With Sheets("Data")
    Arr = .Range("A3:N" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
  End With
  ReDim KQ(1 To UBound(Arr) + 2, 1 To 9)
  aCol = Array(, , 2, 3, 4, 5, 8, 9, 14)
  With Sheets("rptBKTGT")
    idSub = .Range("B2").Value
    For i = 1 To UBound(Arr)
      If Arr(i, 1) = idSub Then
        t = t + 1
        KQ(t, 1) = t
        For j = 2 To 8
          KQ(t, j) = Arr(i, aCol(j))
        Next j
        If KQ(t, 4) = Empty Then KQ(t, 4) = Arr(i, 6)
        tong = tong + Arr(i, 5)
      End If
    Next
    KQ(t + 1, 2) = .Range("J1").Value:    KQ(t + 1, 5) = tong
    KQ(t + 2, 2) = .Range("J2").Value:    KQ(t + 2, 5) = .Range("J3").Value
    i = .Cells(Rows.Count, 2).End(xlUp).Row
    If i > 3 Then .Range("A4:H" & i).Clear
    If t > 0 Then
      .Range("D4").Resize(t).NumberFormat = "@"
      .Range("F4").Resize(t, 2).NumberFormat = "@"
      .Range("A4").Resize(t + 2, 8) = KQ
      .Range("A4").Resize(t + 1, 8).Borders.LineStyle = 1
    End If
  End With
  MsgBox "Xong"
End Sub

 

[HUONGHCKT]

Em chạy code nếu thêm 5 mã IDSub giống nhau thì chương trình bị lỗi. Anh giúp em xử lý lỗi này với!View attachment 262587

Mình thử lại trên máy mình thấy chạy ổn mà..
Bạn lấy code của anh HieuCD mà dùng, gọn hơn và có kẻ dòng định dạng đầy đủ, Hãy gửi lời cảm ơn đến Anh HieuCD nhé

 

[toangm]

Chỉnh code

Bạn lấy code của anh HieuCD mà dùng, gọn hơn và có kẻ dòng định dạng đầy đủ, Hãy gửi lời cảm ơn đến Anh HieuCD nhé

Cảm ơn 2 bác đã nhiệt tình giúp đỡ em!

 

[toangm]

Em muốn nhờ giúp thêm code VBA để thêm một tùy chọn nữa để tổng hợp tạo thành đoạn văn bản như dưới. Em xin cảm ơn!

 

[HUONGHCKT]

Em muốn nhờ giúp thêm code VBA để thêm một tùy chọn nữa để tổng hợp tạo thành đoạn văn bản như dưới. Em xin cảm ơn!
View attachment 262674

Của bạn đây. nhớ là vùng I1:K8 không được xóa
nếu muốn ghi chú vào chung 1 ô thì bỏ dấu " ' ' ở đầu dòng trong code đã chú dẫn cụ thể.

 

[toangm]

Của bạn đây. nhớ là vùng I1:K8 không được xóa
nếu muốn ghi chú vào chung 1 ô thì bỏ dấu " ' ' ở đầu dòng trong code đã chú dẫn cụ thể.

Đúng cái em đang bí, lay hoay làm mà không nghĩ ra. Cảm ơn bác một lần nữa!