Giúp code lọc dữ liệu ( khác điều kiện đã cho trước )

[minhtuan55]

Chào cả nhà GPE !
Em cần 1 đoạn code lọc dữ liệu ra khác các tên đã cho trước. Xin chân thành cảm ơn !

 

[♫ђöล♥ßล†♥†µ♫]

Chào cả nhà GPE !
Em cần 1 đoạn code lọc dữ liệu ra khác các tên đã cho trước. Xin chân thành cảm ơn !

View attachment 205882

Em Re cót được đoạn này

Sub Locdulieu()
    Dim Dic As Object, sArr(), dArr(), tArr(), I As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
tArr = Range("D3", Range("D3").End(xlDown)).Value
For I = 1 To UBound(tArr)
    Dic.Item(tArr(I, 1)) = "Con Nai vang ngo ngac"
Next I
sArr = Range("B3", Range("B" & Rows.Count).End(xlUp)).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For I = 1 To UBound(sArr)
    If Not Dic.Exists(sArr(I, 1)) Then
        K = K + 1
        dArr(K, 1) = sArr(I, 1)
    End If
Next I
Range("G3").Resize(K) = dArr
Set Dic = Nothing
End Sub

 

[concogia]

Chào cả nhà GPE !
Em cần 1 đoạn code lọc dữ liệu ra khác các tên đã cho trước. Xin chân thành cảm ơn !

View attachment 205882

Một cách viết theo đề bài:

Public Sub Loc()
    Dim DsHt, Kq, Khach, I, K
    DsHt = Range([B3], [B1000].End(xlUp))
    Khach = "@" & Replace(Application.Trim(Join(Application.Transpose(Range("D3:D10")))), " ", "@") & "@"
    ReDim Kq(1 To UBound(DsHt), 1 To 1)
        For I = 1 To UBound(DsHt)
            If InStr(Khach, "@" & DsHt(I, 1) & "@") = 0 Then
                K = K + 1
                Kq(K, 1) = DsHt(I, 1)
            End If
        Next I
    [F3].Resize(UBound(DsHt)).ClearContents
    [F3].Resize(K) = Kq
End Sub

Thân

 

[VetMini]

Bài này chỉ khoảng trăm số để dò là tối đa. Dùng luôn hàm match cho gọn, kiểu cọ mà chi
Set Khach = Range("D3: D10")
For I = 1 To UBound(DsHt)
If IsError(Application.Match(DsHt(I, 1), Khach, 0)) Then

 

[ndu96081631]

Chào cả nhà GPE !
Em cần 1 đoạn code lọc dữ liệu ra khác các tên đã cho trước. Xin chân thành cảm ơn !

View attachment 205882

Dùng Advaned Filter, tưởng không còn gì dễ hơn
???
(Với công thức điều kiện =COUNTIF($D$3:$D$5,B3)=0)
Muốn code VBA cứ record macro quá trình lọc bằng tay, bảo đảm code không quá 5 dòng

 

[Hai Lúa Miền Tây]

Dùng Advaned Filter, tưởng không còn gì dễ hơn
???
(Với công thức điều kiện =COUNTIF($D$3:$D$5,B3)=0)
Muốn code VBA cứ record macro quá trình lọc bằng tay, bảo đảm code không quá 5 dòng

Bài này rất khó!!! Nên từ trên xuống dưới không có bài nào làm đúng được kết quả theo yêu cầu. Bài này #5 của Sư Phụ cũng không ngoại lệ.

 

[ndu96081631]

Bài này rất khó!!!

Vụ gì đây?
---------------------------
Ah... ừ đúng hen. Có giá trị 15 hổng biết tại sao lại bỏ
???

 

[be_09]

Bài này rất khó!!! Nên từ trên xuống dưới không có bài nào làm đúng được kết quả theo yêu cầu. Bài này #5 của Sư Phụ cũng không ngoại lệ.

Cái bài này anh thấy dễ ợt, dùng Advanced Filter hoặc tách sheet đều làm được (nhưng người ta chuyên bán PM).

 

[Hai Lúa Miền Tây]

Cái bài này anh thấy dễ ợt, dùng Advanced Filter hoặc tách sheet đều làm được (nhưng người ta chuyên bán PM).

Không dùng theo cách anh được đâu vì kết quả của anh sẽ có số 15, còn tác giả yêu cầu đâu có số 15???

 

[be_09]

Không dùng theo cách anh được đâu vì kết quả của anh sẽ có số 15, còn tác giả yêu cầu đâu có số 15???

Thì anh cho nó một điều kiện Khác vậy thì chắc là được.

 

[chiendich]

Thì anh cho nó một điều kiện Khác vậy thì chắc là được.

chuyển dữ liệu xuống đến dòng 8 thì ok., tác giả gõ tay nên thiếu số 15 hoặc xóa điều kiện 15 sau khi advan....

 

[chiendich]

Dùng code này đúng hơn! kết hợp với Advanced Filter .
Sub sheet1()
a = Range("D2" & [D65000].End(xlUp).Row)
Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
MonDico1(c) = ""
Next c
B = Range("B2:B" & [B65000].End(xlUp).Row)
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In B
If Not MonDico1.exists(c) Then MonDico2(c) = ""
Next c
[I2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.keys)
End Sub

 

[ndu96081631]

Dùng code này đúng hơn! kết hợp với Advanced Filter .
Sub sheet1()
a = Range("D2" & [D65000].End(xlUp).Row)
Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
MonDico1(c) = ""
Next c
B = Range("B2:B" & [B65000].End(xlUp).Row)
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In B
If Not MonDico1.exists(c) Then MonDico2(c) = ""
Next c
[I2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.keys)
End Sub

Code này chưa chắc đúng! Sao bạn nghĩ rằng người ta cần lọc duy nhất kết quả?

 

[chiendich]

Code này chưa chắc đúng! Sao bạn nghĩ rằng người ta cần lọc duy nhất kết quả?

Thì em thấy ra đúng yêu cầu tại #1, còn sao nữa thì phải nhờ đến thầy và các anh chị thôi️, rất mong được học hỏi nhiều từ thầy. Cảm ơn thầy rất nhiều ạ.

 

[Hai Lúa Miền Tây]

Vụ gì đây?
---------------------------
Ah... ừ đúng hen. Có giá trị 15 hổng biết tại sao lại bỏ
???

Em vẫn thích dùng ADO, số 15 không biết sao bỏ thì em loại ra đại, trật hay trúng gì đó thì chờ tác giả cho ý kiến rồi tính tiếp

Sub test()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("H8").CopyFromRecordset .Execute("select a.F1 from [Sheet1$B3:B] a left join [Sheet1$D3:D] b on a.F1=B.F1 where b.F1 is null and a.F1<>15")
    End With
End Sub

 

[befaint]

chờ tác giả cho ý kiến rồi tính tiếp

Hình như anh sẽ chờ khá lâu đó anh.

Vì sau khi có bài #2, chủ thớt đã quay lại... rồi vào phòng thí nghiệm chạy thử code ít nhất một tháng mới tính tiếp.

 

[be_09]

Hình như anh sẽ chờ khá lâu đó anh.
Vì sau khi có bài #2, chủ thớt đã quay lại... rồi vào phòng thí nghiệm chạy thử code ít nhất một tháng mới tính tiếp.

Chủ Topic vào đọc bài 8 nên chạy rồi.

 

[VetMini]

Bài này rất khó!!! Nên từ trên xuống dưới không có bài nào làm đúng được kết quả theo yêu cầu. Bài này #5 của Sư Phụ cũng không ngoại lệ.

Không dùng theo cách anh được đâu vì kết quả của anh sẽ có số 15, còn tác giả yêu cầu đâu có số 15???

Đây là loại kết quả mà thớt dùng để đối phó với những hợp đồng "trả tiền sau khi đã thử code chạy đúng 100%"

Hình như anh sẽ chờ khá lâu đó anh.

Vì sau khi có bài #2, chủ thớt đã quay lại... rồi vào phòng thí nghiệm chạy thử code ít nhất một tháng mới tính tiếp.

Bao lâu không quan trọng.
Trước đây tôi vẫn rất thắc mắc là thớt sẽ thử như thế nào. Nhưng sau thớt này thì biết rồi.

 

[VetMini]

Em vẫn thích dùng ADO, số 15 không biết sao bỏ thì em loại ra đại, trật hay trúng gì đó thì chờ tác giả cho ý kiến rồi tính tiếp

Sub test()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("H8").CopyFromRecordset .Execute("select a.F1 from [Sheet1$B3:B] a left join [Sheet1$D3:D] b on a.F1=B.F1 where b.F1 is null and a.F1<>15")
    End With
End Sub

Ai mà biết thực ra cái "danh sách ngoại lệ" nó còn dài bao nhiêu. Trường hợp này thì tôi dùng một danh sách luôn.
Where b.F1 is Null And a.F1 Not In (15, chỗ còn lại,...)

Chú: dùng Not In tuy trông gọn rõ nhưng có cái nguy hiểm của nó. Trường hợp này thì không sao, nhưng bạn nào muốn bước vào thì nên tìm hiểu những chỗ nguy hiểm trước.

 

[Hai Lúa Miền Tây]

Ai mà biết thực ra cái "danh sách ngoại lệ" nó còn dài bao nhiêu. Trường hợp này thì tôi dùng một danh sách luôn.
Where b.F1 is Null And a.F1 Not In (15, chỗ còn lại,...)

Chú: dùng Not In tuy trông gọn rõ nhưng có cái nguy hiểm của nó. Trường hợp này thì không sao, nhưng bạn nào muốn bước vào thì nên tìm hiểu những chỗ nguy hiểm trước.

Em rất hạn chế dung IN, bởi lẽ khi điều kiện là dữ liệu lớn thì nó ảnh hưởng về tốc độ khi truy vấn. Thay vào đó thì em thích dùng join hơn.