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

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
N

nguyenmanhnam

Thành viên tiêu biểu
Tham gia
24/7/10
Bài viết
434
Được thích
266
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!
 

File đính kèm

nguyenmanhnam đã viết:
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!
Nhấp chuột vào đây để mở rộng...
Thêm 1 cách nữa để tham khảo nhé, k được hay lắm, hiiiiiiiiiiii
PHP: 
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
 

File đính kèm

Thêm cách này nữa xem sao
PHP: 
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
 
Lần chỉnh sửa cuối:
hungpecc1 đã viết:
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 :)
Nhấp chuột vào đây để mở rộng...

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]
 

File đính kèm

hungpecc1 đã viết:
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 :)
Nhấp chuột vào đây để mở rộng...

Code của bạn là:
Mã: 
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à:
Mã: 
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:
Mã: 
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
------------------------
Hoàng Trọng Nghĩa đã viết:
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ả!
Nhấp chuột vào đây để mở rộng...
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?
 
Lần chỉnh sửa cuối:
quanghai1969 đã viết:
Thêm cách này nữa xem sao
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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!!!!
 
ndu96081631 đã viết:
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?
Nhấp chuột vào đây để mở rộng...

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

Mã: 
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ì:

Mã: 
    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:

Mã: 
    Select Case Target.Value
      Case "XN1": lC = 0
      Case "XN2": lC = 1
      Case "XN3": lC = 2
    End Select
 
Lần chỉnh sửa cuối:
Hoàng Trọng Nghĩa đã viết:
Cái thuật toán quan trọng là cái này nè Thầy:

Mã: 
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.
Nhấp chuột vào đây để mở rộng...

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!
 
ndu96081631 đã viết:
Code của bạn là:
Mã: 
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?
Nhấp chuột vào đây để mở rộ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
 
ndu96081631 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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é, ^^
PHP: 
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
 
ndu96081631 đã viết:
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!
Nhấp chuột vào đây để mở rộng...

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.
 
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à
PHP: 
Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub
 
quanghai1969 đã viết:
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à
PHP: 
Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub
Nhấp chuột vào đây để mở rộng...

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
 
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
 

File đính kèm

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.
 
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
 
Hoàng Trọng Nghĩa đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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)
------------------------
quanghai1969 đã viết:
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à
PHP: 
Sub loc2()
[E3:E1000].Clear
[A2:C10000].AdvancedFilter 2, [E2:E3], [E2], 1
End Sub
Nhấp chuột vào đây để mở rộng...
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ả)
 
ndu96081631 đã viết:
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ả)
Nhấp chuột vào đây để mở rộng...


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

Mã: 
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:

Mã: 
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!
 

File đính kèm

ndu96081631 đã viết:
- 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
Nhấp chuột vào đây để mở rộng...

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.
 
Hoàng Trọng Nghĩa đã viết:
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


Kết quả đúng sẽ là không trùng và lọc đến 65517 dòng!
Nhấp chuột vào đây để mở rộng...

Cũng nhanh đấy nhưng mà chưa có nhanh hơn công cụ Excel đâu
Tôi dùng con dao bén hơn chút:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range) 'Bo so 1 o Change1 de thu.
  Dim rng As Range
  Dim lC As Long
  Dim t As Double
  If Target.Address = "$E$2" Then
    t = Timer
    Set rng = Range("A3:A65536")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    Set rng = rng.Offset(, lC)
    With Target.Offset(1).Resize(rng.Rows.Count)
      .Value = rng.Value
      .RemoveDuplicates 1, xlNo
    End With
    MsgBox Format(Timer - t, "0.000")
  End If
End Sub
Thi đấu với điều kiện lọc ="XN2", code tôi nhanh hơn của Nghĩa 3 lần
Ẹc... Ẹc...
---------------
Tuy nhiên, như thế cũng chưa có sướng, làm vầy cho nó sung:
- Hãy SaveAs file thành xlsm rồi copy dữ liệu ra 400,000 dòng, xong thử code nhé
- Riêng cột XN2, hãy chọn cell B3 rồi fill xuống "mút chỉ" đến cuối ---> Mục đích không cho em nào trùng
- Giờ dùng code lọc theo điều kiện "XN2"
 
ndu96081631 đã viết:
Cũng nhanh đấy nhưng mà chưa có nhanh hơn công cụ Excel đâu
Tôi dùng con dao bén hơn chút:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range) 'Bo so 1 o Change1 de thu.
  Dim rng As Range
  Dim lC As Long
  Dim t As Double
  If Target.Address = "$E$2" Then
    t = Timer
    Set rng = Range("A3:A65536")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    Set rng = rng.Offset(, lC)
    With Target.Offset(1).Resize(rng.Rows.Count)
      .Value = rng.Value
      .RemoveDuplicates 1, xlNo
    End With
    MsgBox Format(Timer - t, "0.000")
  End If
End Sub
Thi đấu với điều kiện lọc ="XN2", code tôi nhanh hơn của Nghĩa 3 lần
Ẹc... Ẹc...
---------------
Tuy nhiên, như thế cũng chưa có sướng, làm vầy cho nó sung:
- Hãy SaveAs file thành xlsm rồi copy dữ liệu ra 400,000 dòng, xong thử code nhé
- Riêng cột XN2, hãy chọn cell B3 rồi fill xuống "mút chỉ" đến cuối ---> Mục đích không cho em nào trùng
- Giờ dùng code lọc theo điều kiện "XN2"
Nhấp chuột vào đây để mở rộng...
Mình nghĩ với chiêu RemoveDuplicates thì có lẽ vô địch rồi, không cần bàn cãi gì ráo.
 
quanghai1969 đã viết:
Mình nghĩ với chiêu RemoveDuplicates thì có lẽ vô địch rồi, không cần bàn cãi gì ráo.
Nhấp chuột vào đây để mở rộng...

Ngoài ra còn có ADO cũng cho tốc độ rất nhanh.
ADO được cái là cho tốc độ ổn định, dù số lượng phần tử trùng nhiều hay ít thì thời gian lọc cũng không chênh lệch bao nhiêu
Có điều có 1 thắc mắc. Câu lệnh:
PHP: 
SELECT DISTINCT FieldName FROM [DataBase]
Thí nghiệm thấy DataBase nếu vượt quá 65536 dòng thì code báo lỗi, chẳng biết tại sao?
 
ndu96081631 đã viết:
Cũng nhanh đấy nhưng mà chưa có nhanh hơn công cụ Excel đâu
Tôi dùng con dao bén hơn chút:
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range) 'Bo so 1 o Change1 de thu.
  Dim rng As Range
  Dim lC As Long
  Dim t As Double
  If Target.Address = "$E$2" Then
    t = Timer
    Set rng = Range("A3:A65536")
    Select Case Target.Value
      Case Is = "XN1": lC = 0
      Case Is = "XN2": lC = 1
      Case Is = "XN3": lC = 2
    End Select
    Set rng = rng.Offset(, lC)
    With Target.Offset(1).Resize(rng.Rows.Count)
      .Value = rng.Value
      .RemoveDuplicates 1, xlNo
    End With
    MsgBox Format(Timer - t, "0.000")
  End If
End Sub
Thi đấu với điều kiện lọc ="XN2", code tôi nhanh hơn của Nghĩa 3 lần
Ẹc... Ẹc...
---------------
Tuy nhiên, như thế cũng chưa có sướng, làm vầy cho nó sung:
- Hãy SaveAs file thành xlsm rồi copy dữ liệu ra 400,000 dòng, xong thử code nhé
- Riêng cột XN2, hãy chọn cell B3 rồi fill xuống "mút chỉ" đến cuối ---> Mục đích không cho em nào trùng
- Giờ dùng code lọc theo điều kiện "XN2"
Nhấp chuột vào đây để mở rộng...

Đúng ra mà nói thì Advanced Filter Unique nó rất nhanh, với điều kiện các mục lọc được trong khoảng 20,000 dòng thì không có cái Hàm nào hay phương thức nào lọc nhanh hơn được.

Vì muốn chứng minh câu nói "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" của Thầy là chưa chính xác nên mới đưa ra số mục hơn số đó, cho nên AFU bị "tèo".

Riêng với phương thức Remove Duplicates thì nó tỏ ra rất nhanh, phải copy qua 1 vùng khác, từ vùng này sẽ thực hiện RD. Tuy nhiên, cái này cũng sẽ "tèo" nếu thực hiện trên Excel 2003 trở về trước.

==> Tùy "phương tiện" của mình đang có là gì, tùy vào trường hợp trên sheet hay mảng... ta có 1 phương thức thực hiện cái này hay cái khác hoặc kết hợp nhiều phương thức lại để thực hiện.

Tuy nhiên, để dung hòa về thời gian, phiên bản, tính chính xác thì dùng HÀM để lọc thì tôi cho là hợp lý nhất.
 
Hoàng Trọng Nghĩa đã viết:
Tuy nhiên, để dung hòa về thời gian, phiên bản, tính chính xác thì dùng HÀM để lọc thì tôi cho là hợp lý nhất.
Nhấp chuột vào đây để mở rộng...

Ấy! Có hợp lý hay không thì phải xem NGƯỜI DÙNG: Nếu họ xài cái của mình thì kết luận cái của mình hợp lý, ngược lại thì... Ẹc... Ẹc...
Tôi nói đúng chứ? Tôi nói câu này là nói chung cho bất kỳ ai viết phần mềm, không riêng gì hàm của Nghĩa đâu!
(Nay là năm 2013 rồi, ai còn xài Office 2003 thì ráng chịu thôi, trách ai?)
 
ndu96081631 đã viết:
Ấy! Có hợp lý hay không thì phải xem NGƯỜI DÙNG: Nếu họ xài cái của mình thì kết luận cái của mình hợp lý, ngược lại thì... Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...

Em đã nói câu này:

==> Tùy "phương tiện" của mình đang có là gì, tùy vào trường hợp trên sheet hay mảng... ta có 1 phương thức thực hiện cái này hay cái khác hoặc kết hợp nhiều phương thức lại để thực hiện.
Nhấp chuột vào đây để mở rộng...

Còn câu nói cuối cùng đó là quan điểm của cá nhân em thôi.


ndu96081631 đã viết:
Tôi nói đúng chứ? Tôi nói câu này là nói chung cho bất kỳ ai viết phần mềm, không riêng gì hàm của Nghĩa đâu!
(Nay là năm 2013 rồi, ai còn xài Office 2003 thì ráng chịu thôi, trách ai?)
Nhấp chuột vào đây để mở rộng...

Theo thống kê tại Việt Nam thì cho tới hiện nay có tới hơn 85% người dùng đang xài WinXP và Excel 2003 đó Thầy, liệu 85% người dùng Việt Nam có chịu đổi tất cả qua phiên bản mới hay không? Liệu có thay đổi hết máy tính hay không vì nếu thay phiên bản Win mới thì phải thay đổi luôn cả máy tính lỗi thời, chưa kể giá bản quyền của mỗi loại Win và Office nó có thể lên tới chục triệu! Thử hỏi có nên thay đổi hay không nếu người ta không cần đến những cái xa xỉ trong những phiên bản mới?

Đồng ý rằng chúng ta cập nhật cái mới, nhưng chắc cũng để đó, cho đến khi "dân giàu, nước mạnh" thì cũng sẽ dùng tới thôi!
 
Lần chỉnh sửa cuối:
Hoàng Trọng Nghĩa đã viết:
Theo thống kê tại Việt Nam thì cho tới hiện nay có tới hơn 85% người dùng đang xài WinXP và Excel 2003 đó Thầy, liệu 85% người dùng Việt Nam có chịu đổi tất cả qua phiên bản mới hay không? Liệu có thay đổi hết máy tính hay không vì nếu thay phiên bản Win mới thì phải thay đổi luôn cả máy tính lỗi thời, chưa kể giá bản quyền của mỗi loại Win và Office nó có thể lên tới chục triệu! Thử hỏi có nên thay đổi hay không nếu người ta không cần đến những cái xa xỉ trong những phiên bản mới?

Đồng ý rằng chúng ta cập nhật cái mới, nhưng chắc cũng để đó, cho đến khi "dân giàu, nước mạnh" thì cũng sẽ dùng tới thôi!
Nhấp chuột vào đây để mở rộng...
Tôi nghĩ vấn đề cập nhật mới không phải liên quan đến tiền mà là thói quen (xài quen thì không muốn thay đổi)
Tuy nhiên....
Lần trước khi tôi đi mua Laptop, người ta cài sẵn cho Windows 7 + Office 2010. Vì tôi không quen xài nên dự định sẽ cài lại Windows XP + Office 2003
Ác cái là sau khi cài xong thì chẳng tìm thấy đâu ra Driver tương thích với XP (hảng sản xuất không hổ trợ).
Trường hợp này Nghĩa nghĩ sao? Một là cứ dùng XP + Office 2003 và.. chịu thiệt thòi, hai là cố mà tìm hiểu cái mới
Vậy đấy! Mấy chục phần trăm xài cái gì thây kệ họ, đến lúc họ cảm thấy thiệt thòi thì tự họ sẽ phải nâng cấp (ví dụ nhận file xlsx của ai đó gửi mà cóc mở được)
---------------------------------------
Cũng là tản mạn chơi trong ngày đầu xuân chứ quan điểm mỗi người thi... Ẹc... Ẹc... Ai cấm! Thích sao, cứ tùy ý!
 
cũng xin góp tí gió... vào câu chuyện của các anh (cũng xin lỗi ko phải box giao lưu).
thực ra máy tinh cá nhân thì xài phiên bản nào cũng được (miễm là cấu hình đủ chơi là được).
nhưng ở môi trường công ty thì khác, vì phải sử dụng phiên bản có bản quyền nên mỗi lần nâng cấp là phiền phức lắm, mấy xếp cứ hỏi mày nâng cấp để làm gì? nhiều đó xài đủ rồi.....
chắn lẻ nói với xếp để em cập nhật cho kịp GPE.....hì hì.....
năm hết tết đến, tám vài câu cho vui
chúc các anh ăn tết vui vẻ
 
nhapmon đã viết:
mấy xếp cứ hỏi mày nâng cấp để làm gì? nhiều đó xài đủ rồi.....
chắn lẻ nói với xếp để em cập nhật cho kịp GPE.....hì hì.....ẻ
Nhấp chuột vào đây để mở rộng...
Khi nào sếp bạn nhận được file xlsx từ đối tác nước ngoài gửi đến, ổng đọc không được thì tự nhiên ổng sẽ.. hết ngay chứ gì
Chuyện thường!
 
ndu96081631 đã viết:
Khi nào sếp bạn nhận được file xlsx từ đối tác nước ngoài gửi đến, ổng đọc không được thì tự nhiên ổng sẽ.. hết ngay chứ gì
Chuyện thường!
Nhấp chuột vào đây để mở rộng...

Có khi ông ta đề nghị đối tác Convert xuống 2003 trước khi gửi nữa chứ! Gửi mail lẹ hơn đổi toàn bộ máy tính mà Thầy!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

N
  • Question Question
Sự kiện keydown & textbox user form (1 người xem)
Trả lời
0
Đọc
14
nguyenduy39
N
T
  • Question Question
Kết quả lọc dữ liệu từ sheet TONG HOP qua từng chi tiết (2 người xem)
Trả lời
1
Đọc
33
HUONGHCKT
H
S
Cảm ơn Admin đã duyệt
Trả lời
0
Đọc
25
samthai8017
S
S
Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới). Thank
Trả lời
4
Đọc
59
samthai8017
S
S
Xin các Pro chia sẻ giúp (1 người xem)
Trả lời
4
Đọc
61
samthai8017
S
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
1
Đọc
485
GPE-Trợ Lý
GPE-Trợ Lý
B
Em nhờ các bro giúp giải pháp in nhiều file ạ
Trả lời
3
Đọc
61
Hoàng Tuấn 868
H
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu
    • Cười
Trả lời
17
Đọc
327
LOGANWover
L
HeSanbi
  • Question Question
VBScript.RegExp sẽ bị xóa khỏi Windows: thư viện Pcre2 giải pháp thay thế tối ưu
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
80
HeSanbi
HeSanbi
S
Xin hỏi các pro. Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới).
Trả lời
3
Đọc
61
samthai8017
S
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable (2 người xem)
Trả lời
2
Đọc
68
thuhacoicoi
T
HeSanbi
  • Question Question
Chuyển mã VBA ứng dụng Excel 32 bit hoạt động trên cả 64bit (Hoàn toàn 0 phí) (1 người xem)
    • Thích
Trả lời
0
Đọc
62
HeSanbi
HeSanbi
T
Ctrl + Shift + 0 không dùng để unhide cột được
Trả lời
24
Đọc
22K
Oji
O
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
    • Yêu thích
Trả lời
19
Đọc
4K
Hoàng Tuấn 868
H
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
3
Đọc
98
HeSanbi
HeSanbi
huytamlinh
Anh Chị giúp em sửa lỗi định dạng với ạ !
Trả lời
3
Đọc
50
Hoàng Tuấn 868
H
T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp!
Trả lời
1
Đọc
61
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
4
Đọc
926
nguyendang95
N
V
Quản lý xuất nhập vật tư trong kho
Trả lời
19
Đọc
768
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
4
Đọc
357
phuongnam366377
phuongnam366377
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom