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 ạ!
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.
