Dear quý anh chị
Do tìm diễn đàn ko có bài nào phù hợp với công việc của mình.
Nên đăng lên đây, nhờ anh chị chỉ giúp.
Sheet(TC_BCCT) sẽ lọc ra điều kiện tại ô L1,L3 theo ngày tháng L5,L7
Dữ liệu được kết hợp từ sheet Mhang, Bhang, TC
Trước đó em đã thử chạy rồi, nhưng kết quả chạy rất chậm chạp.
EM cám ơn nhiều.
Đọc dữ liệu trên 3 sheet mà bạn nêu, tôi chưa hiểu mong muốn của bạn. Nếu báo cáo theo đối tượng thì bạn để ở sheet TC_BCCT là khách lẻ 7 nhưng trong Bhang có ông KH0007 nào đâu? Ít nhất bạn phải có dữ liệu đúng và 1 cái kết quả mong muốn đúng để người giúp bạn dễ hình dung.
Cái form để chọn KH trong Bhang gây trở ngại quá lớn, có khi đây là lý do code chạy chậm. (À mà cái code đó sao bạn lại xóa đi? Để nguyên có khi tôi hình dung được bạn lấy dữ liệu thế náo để lên báo cáo, khỏi mất công hỏi thế này)
Mình cứ cắm cúi vào code, vào vẽ mấy cái form làm gì.
Cái cần làm là nắm chắc kiến thức về xây dựng cấu trúc dữ liệu chuẩn, thiết kế các bảng hợp lý.
Kế đó là tập lại cách trình bày vấn đề sao cho rõ ràng, rành mạch (cái này học từ môn Ngữ Văn từ cấp 2 ấy).
---
Khi nêu đề bài thì tập trung nêu cái yêu cầu của mình ấy, đừng tập trung kể câu chuyện riêng tư của mình. Tức là tạm gác, tạm quên cái vấn đề của mình đi, cứ nêu bài toán từ đầu đã.
Đề bài có thể nêu vắn tắt như này:
Cho 4 điều kiện ở Sheet(TC_BCCT) như mô tả tại K1:L7
Tìm kiếm trong 3 sheets Mhang, Bhang, TC.
Kết quả lọc cần trả về dữ liệu ở 3 cột [Mã đối tượng, Tên đối tượng, Loại], chi tiết minh học như các hình dưới.
Đấy, học giỏi Văn là để trình bày Toán sao cho chuẩn, sao cho dễ đọc, dễ hiểu. Giỏi Toán không mà Văn kém thì cũng bỏ.
Dim NgayDau As Date, NgayCuoi As Date
NgayDau = Sheet8.[J5]: NgayCuoi = Sheet8.[J7]
Sheet8.Range("A11:M10000").ClearContents ' xoa du lieu cu
If Sheet8.AutoFilterMode Then Sheet8.AutoFilterMode = False ' tat che do loc
Dim sArr(), dArr(1 To 100000, 1 To 30), i As Long, J As Long, k As Long, Rws As Long, M_kh As String, Doituong As String
Dim loaidt As String
loaidt = Sheet8.[J1]
' xet du lieu mua hang
With Sheet1
sArr = .Range(.[C9], .[O100000].End(xlUp)).Resize(, 25).Value2
End With
With Sheet8
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr)
If sArr(i, 1) >= NgayDau And sArr(i, 13) = M_kh Then
If sArr(i, 1) < NgayCuoi Then
If sArr(i, 1) <> Empty Then
If sArr(i, 15) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr(i, 1) ' ngay ghi so
dArr(k, 3) = sArr(i, 3) ' dien giai chung
dArr(k, 4) = sArr(i, 12) ' dien giai chi tiet
dArr(k, 5) = sArr(i, 8) ' ten hang
dArr(k, 6) = sArr(i, 9) ' don vi tinh
dArr(k, 7) = sArr(i, 10) ' so luong
dArr(k, 8) = sArr(i, 11) ' don gia
dArr(k, 9) = sArr(i, 5) ' thanh tien
dArr(k, 10) = sArr(i, 4) ' thanh toan
dArr(k, 11) = sArr(i, 2) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
' xet du lieu ban hang
With Sheet2
sArr = .Range(.[C9], .[O100000].End(xlUp)).Resize(, 25).Value2
End With
With Sheet8
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr)
If sArr(i, 1) >= NgayDau And sArr(i, 13) = M_kh Then
If sArr(i, 1) < NgayCuoi Then
If sArr(i, 1) <> Empty Then
If sArr(i, 15) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr(i, 1) ' ngay ghi so
dArr(k, 3) = sArr(i, 3) ' dien giai chung
dArr(k, 4) = sArr(i, 12) ' dien giai chi tiet
dArr(k, 5) = sArr(i, 8) ' ten hang
dArr(k, 6) = sArr(i, 9) ' don vi tinh
dArr(k, 7) = sArr(i, 10) ' so luong
dArr(k, 8) = sArr(i, 11) ' don gia
dArr(k, 9) = sArr(i, 5) ' thanh tien
dArr(k, 10) = sArr(i, 4) ' thanh toan
dArr(k, 11) = sArr(i, 2) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
' Xet du lieu thu chi
With Sheet3
sArr = .Range(.[C9], .[G100000].End(xlUp)).Resize(, 25).Value2
End With
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr1)
If sArr1(i, 1) >= NgayDau And sArr1(i, 5) = M_kh Then
If sArr1(i, 1) < NgayCuoi Then
If sArr1(i, 1) <> Empty Then
If sArr1(i, 7) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr1(i, 1) ' ngay ghi so
dArr(k, 4) = sArr1(i, 3) ' dien giai chung
dArr(k, 10) = sArr1(i, 4) ' so tien
dArr(k, 11) = sArr1(i, 8) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
End With
End With
' sap xep
With ActiveWorkbook.Worksheets("TC_BCCT").Sort
.SetRange Range("B11:K10000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Hoàn thành"
'loc ket qua
ActiveSheet.Range("$A$10:$K$10000").AutoFilter Field:=2, Criteria1:="<>"
End Sub
Bài đã được tự động gộp:
Xem giúp em cái này nó chậm ở đâu với ạ, có thể xử lý ntn ạ
Em cám ơn nhiều
Dim NgayDau As Date, NgayCuoi As Date
NgayDau = Sheet8.[J5]: NgayCuoi = Sheet8.[J7]
Sheet8.Range("A11:M10000").ClearContents ' xoa du lieu cu
If Sheet8.AutoFilterMode Then Sheet8.AutoFilterMode = False ' tat che do loc
Dim sArr(), dArr(1 To 100000, 1 To 30), i As Long, J As Long, k As Long, Rws As Long, M_kh As String, Doituong As String
Dim loaidt As String
loaidt = Sheet8.[J1]
' xet du lieu mua hang
With Sheet1
sArr = .Range(.[C9], .[O100000].End(xlUp)).Resize(, 25).Value2
End With
With Sheet8
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr)
If sArr(i, 1) >= NgayDau And sArr(i, 13) = M_kh Then
If sArr(i, 1) < NgayCuoi Then
If sArr(i, 1) <> Empty Then
If sArr(i, 15) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr(i, 1) ' ngay ghi so
dArr(k, 3) = sArr(i, 3) ' dien giai chung
dArr(k, 4) = sArr(i, 12) ' dien giai chi tiet
dArr(k, 5) = sArr(i, 8) ' ten hang
dArr(k, 6) = sArr(i, 9) ' don vi tinh
dArr(k, 7) = sArr(i, 10) ' so luong
dArr(k, 8) = sArr(i, 11) ' don gia
dArr(k, 9) = sArr(i, 5) ' thanh tien
dArr(k, 10) = sArr(i, 4) ' thanh toan
dArr(k, 11) = sArr(i, 2) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
' xet du lieu ban hang
With Sheet2
sArr = .Range(.[C9], .[O100000].End(xlUp)).Resize(, 25).Value2
End With
With Sheet8
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr)
If sArr(i, 1) >= NgayDau And sArr(i, 13) = M_kh Then
If sArr(i, 1) < NgayCuoi Then
If sArr(i, 1) <> Empty Then
If sArr(i, 15) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr(i, 1) ' ngay ghi so
dArr(k, 3) = sArr(i, 3) ' dien giai chung
dArr(k, 4) = sArr(i, 12) ' dien giai chi tiet
dArr(k, 5) = sArr(i, 8) ' ten hang
dArr(k, 6) = sArr(i, 9) ' don vi tinh
dArr(k, 7) = sArr(i, 10) ' so luong
dArr(k, 8) = sArr(i, 11) ' don gia
dArr(k, 9) = sArr(i, 5) ' thanh tien
dArr(k, 10) = sArr(i, 4) ' thanh toan
dArr(k, 11) = sArr(i, 2) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
' Xet du lieu thu chi
With Sheet3
sArr = .Range(.[C9], .[G100000].End(xlUp)).Resize(, 25).Value2
End With
M_kh = .Range("J3").Value
For i = 1 To UBound(sArr1)
If sArr1(i, 1) >= NgayDau And sArr1(i, 5) = M_kh Then
If sArr1(i, 1) < NgayCuoi Then
If sArr1(i, 1) <> Empty Then
If sArr1(i, 7) = loaidt Then
k = k + 1
dArr(k, 1) = k ' so thu tu
dArr(k, 2) = sArr1(i, 1) ' ngay ghi so
dArr(k, 4) = sArr1(i, 3) ' dien giai chung
dArr(k, 10) = sArr1(i, 4) ' so tien
dArr(k, 11) = sArr1(i, 8) ' hinh thuc thanh toan
End If
End If
.Range("A11:M10000") = dArr
End If
End If
Next i
End With
End With
' sap xep
With ActiveWorkbook.Worksheets("TC_BCCT").Sort
.SetRange Range("B11:K10000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Hoàn thành"
'loc ket qua
ActiveSheet.Range("$A$10:$K$10000").AutoFilter Field:=2, Criteria1:="<>"
End Sub
Bài đã được tự động gộp:
Xem giúp em cái này nó chậm ở đâu với ạ, có thể xử lý ntn ạ
Em cám ơn nhiều
Dear các anh
Trong code này em có thể thêm dữ liệu sắp xếp ntn thì code có thể chạy được ạ,
Em muốn sắp xếp sau khi gộp dữ liệu theo tiêu chí ngày tháng.
Mà em thử nhiều rồi đều báo lỗi vàng code sắp xếp ạ.
'Sap xep theo ngay
Range("B11:K" & Range("B" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("B11"), Order1:=xlAscending, Header:=xlNo
