Hỏi về lọc duy nhất theo điều kiện (1 người xem)

[nguyenmanhnam]

Nhờ các anh, chị; các thày giúp em bài toán lọc duy nhất theo điều kiện tại file đính kèm. Xin trân trọng cảm ơn!

 

[hungpecc1]

Nhờ các anh, chị; các thày giúp em bài toán lọc duy nhất theo điều kiện tại file đính kèm. Xin trân trọng cảm ơn!

Bạn xem thử file đính kèm có đúng ý đồ của bạn không -> nếu đúng ta tiếp tục edit

 

[hoamattroicoi]

Nhờ các anh, chị; các thày giúp em bài toán lọc duy nhất theo điều kiện tại file đính kèm. Xin trân trọng cảm ơn!

Thêm 1 cách nữa để tham khảo nhé, k được hay lắm, hiiiiiiiiiiii

Sub HMT()
Dim i As Long, k As Long
Dim sArr(), dArr()
Dim DIc As Object

Set DIc = CreateObject("Scripting.dictionary")
sArr() = Range("List").Value
ReDim dArr(1 To UBound(sArr), 1 To 1)

For i = 1 To UBound(sArr)
If Not DIc.exists(sArr(i, 1)) Then
DIc.Add sArr(i, 1), k
    k = k + 1
    dArr(k, 1) = sArr(i, 1)
End If
Next

[E3:E100].ClearContents
If k Then [E3].Resize(k) = dArr
Set DIc = Nothing
End Sub

 

[Quang_Hải]

Thêm cách này nữa xem sao

Sub loc()
   Dim c
   [E3:E1000].Clear
   c = Switch([E2] = "XN1", 1, [E2] = "XN2", 2, [E2] = "XN3", 3)
   Range(Cells(2, c), Cells(65536, c).End(3)).AdvancedFilter 2, , [E2], 1
End Sub

 

[Hoàng Trọng Nghĩa]

Bạn xem thử file đính kèm có đúng ý đồ của bạn không -> nếu đúng ta tiếp tục edit

Làm như vậy cũng được, nhưng nếu 100 cột chắc Select Case "đuối" luôn quá!

------------------------------------------------------------------------------------------

Với bài này ta cần tìm tên cột ở đâu rồi lấy dữ liệu ở cột đó để lọc. Vậy thì điều kiện tìm cột của ta là tiêu đề, từ đó ta có thể dùng phương thức AutoFilter Unique như của bạn hungpecc1 để lọc thì ổn.

Nhưng với bài này, tôi sẽ không dùng phương thức, mà tôi sẽ tặng hàm lọc duy nhất cho tác giả!

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
Dim FindRange As Range
Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not FindRange Is Nothing Then
Range("E3:E65536").ClearContents
Dim UniqueArr As Variant
UniqueArr = NewUnique(Range(FindRange.Offset(1), FindRange.End(xlDown)))
Target.Offset(1).Resize(UBound(UniqueArr)) = UniqueArr
End If
Set FindRange = Nothing
End If
End Sub
[/GPECODE]

 

[ndu96081631]

Bạn xem thử file đính kèm có đúng ý đồ của bạn không -> nếu đúng ta tiếp tục edit

Code của bạn là:

Sub Macro1()
  Dim valXN As String
  [E3:E1000].Clear
  valXN = [E2].Value
  Select Case valXN
    Case Is = "XN1"
      Range("A3", [A65536].End(3)) _
                        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E3"), Unique:=True
    Case Is = "XN2"
      Range("B3", [B65536].End(3)) _
                        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E3"), Unique:=True
    Case Is = "XN3"
      Range("C3", [C65536].End(3)) _
                        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E3"), Unique:=True
  End Select
End Sub

và:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    If Not Intersect(Target, [E2]) Is Nothing Then Call Module1.Macro1
End Sub

Nhận xét: Câu lệnh Select Case chưa đẹp lắm
Tôi thì làm vầy:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  Dim lC As Long
  If Target.Address = "$E$2" Then
    Set rng = Range("A2:C1000")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    rng.Resize(, 1).Offset(, lC).AdvancedFilter 2, , Target, True
  End If
End Sub

Select Case chủ yếu tìm chỉ số cột, sau đó ta định vị vùng dữ liệu dựa vào chỉ số cột đã tìm được ---> Gọn gàng hơn chăng?
Ngoài ra, với Advanced Filter cũng chả cần End(xlUp) hay End(xlDown) gì ráo, cứ cho vùng dữ liệu dư 1 chút, đằng nào thì đúng điều kiện nó mới lọc
------------------------

Nhưng với bài này, tôi sẽ không dùng phương thức, mà tôi sẽ tặng hàm lọc duy nhất cho tác giả!

Dám cá dù viết bất cứ hàm gì cũng không thể nhanh bằng Advanced Filter <---- TIN KHÔNG?

 

[hoamattroicoi]

Thêm cách này nữa xem sao

Sub loc()
   Dim c
   [E3:E1000].Clear
   c = Switch([E2] = "XN1", 1, [E2] = "XN2", 2, [E2] = "XN3", 3)
   Range(Cells(2, c), Cells(65536, c).End(3)).AdvancedFilter 2, , [E2], 1
End Sub

Switch statement thay cho Case và IF trông ngắn hơn nhỉ^^, cái này thú vị à nha, hum nay em mới biết cái thằng Switch này đó, he he he.
Thanks!!!!

 

[Hoàng Trọng Nghĩa]

Dám cá dù viết bất cứ hàm gì cũng không thể nhanh bằng Advanced Filter <---- TIN KHÔNG?

Cái thuật toán quan trọng là cái này nè Thầy:

Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)

Chứ ở đó mà Select Case cho hàng trăm cột chắc gì làm nổi!

Rồi từ đó, muốn làm gì thì làm! Nhiều người đã dùng Advanced Filter rồi, em không dùng em chỉ dùng Hàm cho có nhiều lựa chọn thôi.

---------------------------------------------------------------------------
Cũng nói thêm, để CASE không rườm rà thì thay vì:

    Select Case Target.Value
      Case [COLOR=#ff0000][B]Is =[/B][/COLOR] "XN1": lC = 0
      Case [COLOR=#ff0000][B]Is =[/B][/COLOR] "XN2": lC = 1
      Case [COLOR=#ff0000][B]Is =[/B][/COLOR] "XN3": lC = 2
    End Select

Ta chỉ cần:

    Select Case Target.Value
      Case "XN1": lC = 0
      Case "XN2": lC = 1
      Case "XN3": lC = 2
    End Select

 

[ndu96081631]

Cái thuật toán quan trọng là cái này nè Thầy:

Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)

Chứ ở đó mà Select Case cho hàng trăm cột chắc gì làm nổi!

Rồi từ đó, muốn làm gì thì làm! Nhiều người đã dùng Advanced Filter rồi, em không dùng em chỉ dùng Hàm cho có nhiều lựa chọn thôi.

Tôi đâu có nói đến vụ Select Case hay Find (cái đó tùy trường hợp mà dùng)
Quan trọng là thằng nào lọc nhanh hơn thôi!

 

[hungpecc1]

Code của bạn là:

Sub Macro1()
  Dim valXN As String
  .......
Nhận xét: Câu lệnh Select Case chưa đẹp lắm
Tôi thì làm vầy:
[code]
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  Dim lC As Long
  If Target.Address = "$E$2" Then
    Set rng = Range("A2:C1000")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    rng.Resize(, 1).Offset(, lC).AdvancedFilter 2, , Target, True
  End If
End Sub

Select Case chủ yếu tìm chỉ số cột, sau đó ta định vị vùng dữ liệu dựa vào chỉ số cột đã tìm được ---> Gọn gàng hơn chăng?
Ngoài ra, với Advanced Filter cũng chả cần End(xlUp) hay End(xlDown) gì ráo, cứ cho vùng dữ liệu dư 1 chút, đằng nào thì đúng điều kiện nó mới lọc
------------------------

Dám cá dù viết bất cứ hàm gì cũng không thể nhanh bằng Advanced Filter <---- TIN KHÔNG?

Spam tẹo :
Chỉ click vào " Cảm ơn " em thấy là không đủ,<-----> thanks anh ndu, e cố gắng sẽ hoàn thiện cách viết code VBA hơn

 

[hoamattroicoi]

Tôi đâu có nói đến vụ Select Case hay Find (cái đó tùy trường hợp mà dùng)
Quan trọng là thằng nào lọc nhanh hơn thôi!

Em thấy FIND hay Select Case đều hay mà, nói chung với mấy đứa đang tập tành như em thì cái gì cũng khoái, biết càng nhiều càng ít, cảm ơn anh Nghĩa và sư phụ ndu, cho em hoàn thiện và sửa đổi cái code trên cho đẹp nhé, ^^

Sub HMT()
Dim i As Long, k As Long
Dim sArr(), dArr()
Dim DIc As Object
Dim startCell As Range

Set DIc = CreateObject("Scripting.dictionary")
Set startCell = Range("A2:C2").Find([E2], LookIn:=xlValues, LookAt:=xlWhole) '''em ngu nhat cho nay...
sArr() = startCell.Offset(1).Resize(1000).Value
ReDim dArr(1 To UBound(sArr), 1 To 1)
For i = 1 To UBound(sArr)
If Not DIc.exists(sArr(i, 1)) Then
DIc.Add sArr(i, 1), k
    k = k + 1
    dArr(k, 1) = sArr(i, 1)
End If
Next

[E3:E1000].ClearContents
If k Then [E3].Resize(k) = dArr
Set DIc = Nothing
End Sub

Thanks anh Nghĩa về cái FIND gì gì đó, hiiiiiiiiiiiii

 

[Hoàng Trọng Nghĩa]

Tôi đâu có nói đến vụ Select Case hay Find (cái đó tùy trường hợp mà dùng)
Quan trọng là thằng nào lọc nhanh hơn thôi!

Thầy thấy rồi đó, nếu em làm AdvancedFilter, thì chỉ như vầy thôi:

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
Dim FindRange As Range
Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not FindRange Is Nothing Then
Range("E3:E65536").ClearContents
Range(FindRange.Offset(1), FindRange.End(xlDown)).AdvancedFilter 2, , Target.Offset(1), True
End If
Set FindRange = Nothing
End If
End Sub
[/GPECODE]

Nhưng em muốn nhiều lựa chọn cho bạn ấy dùng, biết đâu bạn ấy không muốn dùng trên sheet, mà dùng trên form để làm nguồn cho combobox hay listbox gì đó thì lại phải tốn thêm 1 cột trong sheet nữa để nạp lên thì sao.

 

[Quang_Hải]

Chẳng hiểu sao bài này đơn giản mà mọi người chơi đao to búa lớn khiếp quá
Vầy cũng lọc được mà

Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub

 

[Hoàng Trọng Nghĩa]

Chẳng hiểu sao bài này đơn giản mà mọi người chơi đao to búa lớn khiếp quá
Vầy cũng lọc được mà

Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub

Ngắn hơn nữa chỉ cần 1 dòng duy nhất, không cần clear:

[A2:C65535].AdvancedFilter 2, [E2:E3], [E2], 1

 

[nguyenmanhnam]

Nhờ tìm chỗ sai trong giải bài toán lọc duy nhất theo điều kiện của em sai ở đâu

Em vô cùng cảm ơn mọi người đã giúp em bài toán lọc duy nhất http://www.giaiphapexcel.com/forum/showthread.php?77098-Hỏi-về-lọc-duy-nhất-theo-điều-kiện bằng VBA, trong khi chờ sự trợ giúp em cố gắng làm 1 phương án bằng cách Test bài toán hoàn toàn tương tự, nhưng không hiểu nó sai ở đâu mà khi chọn tiêu chí lọc là 6 thì nó báo lỗi (trong khi chọn các cái khác đều OK).

Nhờ mọi người chỉ giúp em chỗ sai

 

[Quang_Hải]

Phải công nhận cái hay của AdvancedFilter là biết lấy đến dòng dữ liệu cuối cùng, cái dở của nó lại là không biết loại ra ô bị rỗng ở khoảng giữa. Nhưng dù sao AdvancedFilter lọc gọn thật. Mình khoái cái này vô cùng.

 

[ptm0412]

Trả lời nhanh:

Remind:
offset(A1,0,6) là ở đâu?

Key:
tại sao 1, 2, 3, 5, 6? số 4 đâu?

Tip:
Nếu không có thứ tự và thiếu 4, thì dùng match vào công thức offset

 

[ndu96081631]

Thầy thấy rồi đó, nếu em làm AdvancedFilter, thì chỉ như vầy thôi:

[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
Dim FindRange As Range
Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not FindRange Is Nothing Then
Range("E3:E65536").ClearContents
Range(FindRange.Offset(1), FindRange.End(xlDown)).AdvancedFilter 2, , Target.Offset(1), True
End If
Set FindRange = Nothing
End If
End Sub
[/GPECODE]

Nhưng em muốn nhiều lựa chọn cho bạn ấy dùng, biết đâu bạn ấy không muốn dùng trên sheet, mà dùng trên form để làm nguồn cho combobox hay listbox gì đó thì lại phải tốn thêm 1 cột trong sheet nữa để nạp lên thì sao.

Trời ơi, đồng chí này không hiểu ý mình gì cả:
- Vấn đề không nằm ở chổ code ngắn hay dài
- Vấn đề không phải nằm ở cách viết code
- Mình chỉ muốn nói rằng: Advanced Filter (là công cụ có sẵn) luôn tỏ ra ưu việt hơn so với việc ta viết 1 hàm tự tạo ---> Chỉ vậy thôi! Còn như cùng 1 giải thuật, ai thích viết sao thì tùy ý, tôi đâu có bắt bẻ vụ này (chỉ là sửa cái Select Case của người ta viết sẵn cho gọn hơn)
------------------------

Chẳng hiểu sao bài này đơn giản mà mọi người chơi đao to búa lớn khiếp quá
Vầy cũng lọc được mà

Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub

Gọn hơn chưa chắc đã nhanh hơn, vì Hải phải tốn công Clear dữ liệu (code đầu tiên tôi dùng AdF chẳng có Clear gì cả)

 

[Hoàng Trọng Nghĩa]

Trời ơi, đồng chí này không hiểu ý mình gì cả:
- Vấn đề không nằm ở chổ code ngắn hay dài
- Vấn đề không phải nằm ở cách viết code
- Mình chỉ muốn nói rằng: Advanced Filter (là công cụ có sẵn) luôn tỏ ra ưu việt hơn so với việc ta viết 1 hàm tự tạo ---> Chỉ vậy thôi! Còn như cùng 1 giải thuật, ai thích viết sao thì tùy ý, tôi đâu có bắt bẻ vụ này (chỉ là sửa cái Select Case của người ta viết sẵn cho gọn hơn)
------------------------

Gọn hơn chưa chắc đã nhanh hơn, vì Hải phải tốn công Clear dữ liệu (code đầu tiên tôi dùng AdF chẳng có Clear gì cả)

Em bắt đầu hứng thú với cái màu đỏ rồi đây. Nếu cá về thời gian cũng như tính chính xác thì xin mời với file này!

Giả sử số liệu là một series, nhưng vì lý do nào đó lại có vài trường hợp bị trùng, thế thì phải lọc không trùng!

Với dữ liệu là 65536 dòng, hãy thử với cột B tức điều kiện là XN2 với code của Thầy hay bất cứ của ai lọc bằng Advanced Filter

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range
  Dim lC As Long
  If Target.Address = "$E$2" Then
    Set rng = Range("A2:C65536")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    [COLOR=#ff0000][B]rng.Resize(, 1).Offset(, lC).AdvancedFilter 2, , Target, True[/B][/COLOR]
  End If
End Sub

Và thủ tục dùng hàm NewUnique của em:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then
        Dim FindRange As Range
        Set FindRange = Range("A2:C2").Find(Target, LookIn:=xlValues, LookAt:=xlWhole)
        If Not FindRange Is Nothing Then
            Range("E3:E65536").ClearContents
            Dim UniqueArr As Variant
            [COLOR=#ff0000][B]UniqueArr = NewUnique(Range(FindRange(2), FindRange(65535)))[/B][/COLOR]
            Target.Offset(1).Resize(UBound(UniqueArr)) = UniqueArr
        End If
        Set FindRange = Nothing
    End If
End Sub

Kết quả đúng sẽ là không trùng và lọc đến 65517 dòng!

 

[siwtom]

- Mình chỉ muốn nói rằng: Advanced Filter (là công cụ có sẵn) luôn tỏ ra ưu việt hơn so với việc ta viết 1 hàm tự tạo

Chính xác. Nếu có khả năng thao tác trên sheet thì nên dùng AdvancedFilter vì nó nhanh hơn tia chớp. Nhưng không phải lúc nào cũng có thể thao tác trên sheet. Tự tạo thêm sheet để lọc sau đó hủy thì hơi gượng ép và không đạt được tiêu chí: viết tổng quát để dùng được khi khác - không nhất thiết có sheet hoặc "dính lứu" gì tới sheet hay excel.