Cái này hình như chưa đúng lắm thầy ạ (bỏ qua vấn đề code em còn đang lỗi ở một số ô profit="" không so sánh được nhé). Nếu theo code, tất cả đều thỏa là cứ bỏ trống toàn bộ. Vậy khi resize tăng thêm 1 dòng để gán darr thì dòng cuối là dòng trống chứ sao lại báo lỗi value thầy? ví dụ như darr=1000 dòng 10 cột, mình resize(1001,10) =darr vẫn được mà thầy
Vậy thầy kiểm tra lại giúp em, sao code em để k+1 vậy (điều kiện trên để trống hết), dữ liệu trả về đủ cả mà dòng cuối cùng không bị #N/A vậy ạ? Trường hợp này có đặc biệt gì không thầy
Sau khi thoát vòng lặp thì k chứa số dòng dữ liệu, nếu k=ubound(sarr) thì vùng k+1 sẽ lớn hơn số dòng của mảng dẫn đến lỗi. Cách khắc phục là bạn không nên tìm cách thu gọn code lại dẫn tới khó hiểu, dễ sai, cứ xét if k>0 then resize(k) là được.
Do bạn lấy dữ liệu sArr luôn cả tiêu đề nên số dòng của sArr nhiều hơn dữ liệu 1 dòng. Sau đó dArr lại Redim bằng với sArr
With Sheets("Orders")
sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))Lúc nãy em hỏi là em đã kiểm tra theo code bài #53 thầy ạ, còn từ A1 thì K+1 là vừa đủ thì em biết. Nhưng cuối cùng kiểm tra kỹ lại nó là ở chỗ này (nhiều khi nhanh nhẩu quá khổ):
sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).ValueOption Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Orders")
sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
With Sheets("Filter")
CusName = Split(";" & .Range("B1").Value, ";")
ProCat = Split(";" & .Range("B2").Value, ";")
fDate = .Range("D1").Value
tDate = .Range("D2").Value
Profit = .Range("E2").Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
For i = 1 To UBound(sArr, 1)
For J = 1 To UBound(CusName)
If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
Next
If Bo = False Then GoTo Next_I Else Bo = False
For J = 1 To UBound(ProCat)
If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
Next
If Bo = False Then GoTo Next_I Else Bo = False
If fDate > 0 And tDate > 0 Then
If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
If Bo = False Then GoTo Next_I Else Bo = False
End If
If Profit <> "" Then
If Evaluate(sArr(i, 6) * 1 & Profit) Then Bo = True
If Bo = False Then GoTo Next_I Else Bo = False
End If
K = K + 1
For J = 1 To UBound(sArr, 2)
dArr(K, J) = sArr(i, J)
Next
Next_I:
Next
If K Then
.Range("A4:J10000").ClearContents
.Range("A4").Resize(K, UBound(sArr, 2)) = dArr
End If
End With
Application.ScreenUpdating = True
End SubKể cả .Row (không s) nhưng lấy từ A1:J mà làm sao không dư
ô E2 giá trị Profit format cell là "Text"
Sub XYZ()
Dim sArr(), Res()
Dim i&, n&, k&, j&, sRow&, sCol&
Dim Customer, Product, fDate, eDate, Profit, tmp
With Sheets("Orders")
sArr = .Range("A2:J" & .Range("H" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(sArr): sCol = UBound(sArr, 2)
ReDim Res(1 To sRow, 1 To 10)
With Sheets("Filter")
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 3 Then .Range("A4:J" & i).ClearContents 'Xoa du lieu
Customer = Split(";" & .Range("B1").Value, ";")
If Customer(1) = "*" Then Customer(1) = ""
Product = Split(";" & .Range("B2").Value, ";")
If Product(1) = "*" Then Product(1) = ""
fDate = .Range("D1").Value: eDate = .Range("D2").Value
If Not (IsDate(fDate) And IsDate(eDate)) Or fDate > eDate Then
MsgBox ("Nhap lai dieu kien ngay thang"): Exit Sub
End If
Profit = .Range("E2").Value
If IsNumeric(Profit) And Profit <> Empty Then Profit = "=" & Profit
End With
For i = 1 To sRow
tmp = sArr(i, 8)
For n = 1 To UBound(Customer)
If InStr(1, tmp, Customer(n), vbTextCompare) > 0 Then Exit For
Next n
If n = UBound(Customer) + 1 Then GoTo KhongThoaDieuKien
tmp = sArr(i, 10)
For n = 1 To UBound(Product)
If InStr(1, tmp, Product(n), vbTextCompare) > 0 Then Exit For
Next n
If n = UBound(Product) + 1 Then GoTo KhongThoaDieuKien
If sArr(i, 2) < fDate Or sArr(i, 2) > eDate Then GoTo KhongThoaDieuKien
If Evaluate(Val(sArr(i, 6)) & Profit) Or Profit = Empty Then
k = k + 1
For j = 1 To 10
Res(k, j) = sArr(i, j)
Next j
End If
KhongThoaDieuKien:
Next i
If k Then Sheets("Filter").Range("A4:J4").Resize(k).Value = Res
End Sub
Điều kiện B1 và B2 là chuỗi đầy đủ hay là sao em?
Xin cảm ơn Bác @HieuCD và Bạn @Nhattanktnn đã luôn quan tâm & giúp đỡ OT, cả 2 code chạy khá nhanh ra kết quả chính xác rồi ạ.
Vậy túm lại là em đã tìm ra đáp án cho mình rồi?
Túm lại là có mấy anh và cả mấy chú chiều chuộng rồi. Anh @Hai Lúa Miền Tây có tham gia hông?
Câu nói hay nhất trong ngày đây rồi chú Mỹ, hú hú hú
Còn nửa câu chưa nói: Trong số chiều chuộng đó không có lão ctCâu nói hay nhất trong ngày đây rồi chú Mỹ, hú hú hú
Chú Mỹ không chiều nhưng cũng có tận mấy bài liền rồi vừa là bài làm theo ý của chú, vừa là các bài chỉ dẫn nữa
Nạp hết vào Recordset rồi lọc dữ liệu. Tuy nhiên nếu lọc 1 lần trên dữ liệu thì em có thể dùng kết quả những bài trên. Còn nếu cứ dùng Recordset đó để lọc nhiều lần thì nên dùng cách anh đề nghị.Dạ vầng đúng rồi anh: PQ,VBA,ADO đều đủ cả rồi anh ạ.
Nếu anh Hai Lúa có thêm cách gì độc đáo & và có hứng thì ... tiếp tục đi anh.
Hic anh Hai Lúa nói vậy OT tiếp thu không khác gì đàn gảy tai trâu anh ơi.
Nạp nó tương tự bài Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset đó em.Hic anh Hai Lúa nói vậy OT tiếp thu không khác gì đàn gảy tai trâu anh ơi.
"Còn nếu cứ dùng Recordset đó để lọc nhiều lần thì nên dùng cách anh đề nghị." nếu có hứng thú anh chỉ dẫn thêm cách này nhé anh.
Lão ấy không chiều chuộng, lão làm đơn giản vì lão biết là cổ thôi.Chú Mỹ không chiều nhưng cũng có tận mấy bài liền rồi vừa là bài làm theo ý của chú, vừa là các bài chỉ dẫn nữa
