Trích lọc danh sách duy nhất trong danh sách có chứa dòng rỗng (4 người xem)

[0104tkh]

Trả về danh sách các phần tử duy nhất trong một dãy.

Mình cảm ơn bạn đã chỉ cho mình, cách này mình thử rồi nhưng không được, chắc tại phần vùng trích lọc của mình có chứa công thức vì vậy nên mình muốn sử dụng cách trích lọc khác.
Mình không hiểu tại sao dù đã xóa công thức nhưng khi mình thử chèn dòng trống và thêm vào 1 số liệu không có trong ĐK trích nó vẫn hiểu và trích luôn phần dòng rỗng và số đó.
Mình gửi file đính kèm từ nãy đến giờ nhưng không được, mình sẽ gửi qua địa chỉ mail của bạn, bạn thông cảm nha.​

 

[hienanh5488]

trả về danh sách các phần tử duy nhất trong dãy

anh, chị nào biết công thức trả về danh sách các phần tử duy nhất trong một dãy thì giúp em với, cảm ơn nhiu nhiu

 

[concogia]

anh, chị nào biết công thức trả về danh sách các phần tử duy nhất trong một dãy thì giúp em với, cảm ơn nhiu nhiu

Dạng bài này nếu dữ liệu nhiều mà dùng công thức thì máy chạy mệt mỏi lắm, làm thử cho bạn thôi nhé
Tình cờ đọc được cái thằng New Collection, chẳng hiểu mô tê chi, mò mẫm một hồi thấy nó lọc duy nhất rất nhanh, dữ liệu như trong bài mình thử với 45.000 dòng nó chạy có nửa giây

Public Sub loc()
    Dim Vung, Mg(), Ll As New Collection, Cll As Range, i As Long
    Set Vung = Range([c10], [c50000].End(xlUp))
    Range("D:D").Clear
    On Error Resume Next
        For Each Cll In Vung
            Ll.Add Cll.Value, CStr(Cll.Value)
        Next
            ReDim Mg(Ll.Count - 1)
                For i = 1 To Ll.Count
                    Mg(i - 1) = Ll(i)
                Next i
[d10].Resize(Ll.Count) = Application.WorksheetFunction.Transpose(Mg)
End Sub

Các bạn thử xóa hết công thức & name, thêm vài chục ngàn dòng rồi chạy thử code
Vẫn hổng hiểu
Híc

 

[ThuNghi]

Dạng bài này nếu dữ liệu nhiều mà dùng công thức thì máy chạy mệt mỏi lắm, làm thử cho bạn thôi nhé
Tình cờ đọc được cái thằng New Collection, chẳng hiểu mô tê chi, mò mẫm một hồi thấy nó lọc duy nhất rất nhanh, dữ liệu như trong bài mình thử với 45.000 dòng nó chạy có nửa giây

Public Sub loc()
    Dim Vung, Mg(), Ll As New Collection, Cll As Range, i As Long
    Set Vung = Range([c10], [c50000].End(xlUp))
    Range("D:D").Clear
    On Error Resume Next
        For Each Cll In Vung
            Ll.Add Cll.Value, CStr(Cll.Value)
        Next
            ReDim Mg(Ll.Count - 1)
                For i = 1 To Ll.Count
                    Mg(i - 1) = Ll(i)
                Next i
[d10].Resize(Ll.Count) = Application.WorksheetFunction.Transpose(Mg)
End Sub

Các bạn thử xóa hết công thức & name, thêm vài chục ngàn dòng rồi chạy thử code
Vẫn hổng hiểu
Híc

Anh cogia này vận dụng nhanh ghê. Cám ơn Anh.
Em làm thêm để nghiên cứu thử Dic và new Collection và AdFi nhé.
Dùng Dic

Sub locDic()
Dim T
T = Timer
Dim Vung, Mg(), Arr(), i As Long
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Set Vung = Range([c10], [c65000].End(xlUp))
Arr = Vung.Value
Range("E:E").Clear
For i = 1 To UBound(Arr)
  If Not Dic.exists(Arr(i, 1)) Then
    Dic.Add Arr(i, 1), ""
  End If
Next
  Mg = Dic.keys
[E10].Resize(Dic.Count) = Application.WorksheetFunction.Transpose(Mg)
[a2] = Timer - T
End Sub

Dùng AdFi

Sub locAdFi()
Dim T
T = Timer
    Dim Vung As Range
    Set Vung = Range([c9], [c65000].End(xlUp))
    Range("F:F").Clear
    Vung.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "F9"), Unique:=True
[a3] = Timer - T
End Sub

Em đã thử với 60.000 dòng. Dic là nhanh nhất. Anh kiểm tra giúp em.

 

[ndu96081631]

Dạng bài này nếu dữ liệu nhiều mà dùng công thức thì máy chạy mệt mỏi lắm, làm thử cho bạn thôi nhé
Tình cờ đọc được cái thằng New Collection, chẳng hiểu mô tê chi, mò mẫm một hồi thấy nó lọc duy nhất rất nhanh, dữ liệu như trong bài mình thử với 45.000 dòng nó chạy có nửa giây

Public Sub loc()
    Dim Vung, Mg(), Ll As New Collection, Cll As Range, i As Long
    Set Vung = Range([c10], [c50000].End(xlUp))
    Range("D:D").Clear
    On Error Resume Next
        For Each Cll In Vung
            Ll.Add Cll.Value, CStr(Cll.Value)
        Next
            ReDim Mg(Ll.Count - 1)
                For i = 1 To Ll.Count
                    Mg(i - 1) = Ll(i)
                Next i
[d10].Resize(Ll.Count) = Application.WorksheetFunction.Transpose(Mg)
End Sub

Các bạn thử xóa hết công thức & name, thêm vài chục ngàn dòng rồi chạy thử code
Vẫn hổng hiểu
Híc

Anh dùng Collection thế này thì có thể thi đấu tốc độ với Dictionary của ThuNghi đấy:

Sub Loc()
  Dim Arr(), TmpArr, Item, iCount As Long, Dur As Double
  Dur = Timer
  With Range([C10], [C65536].End(xlUp))
    TmpArr = .Value
    ReDim Arr(1 To .Count)
  End With
  Range("D:D").Clear
  On Error Resume Next
  With New Collection
    For Each Item In TmpArr
      iCount = .Count
      .Add Item, CStr(Item)
      If iCount <> .Count Then Arr(.Count) = Item
    Next
    Range("D10").Resize(.Count) = WorksheetFunction.Transpose(Arr)
  End With
  MsgBox Format(Timer - Dur, "0.000000")
End Sub

Tốc độ của Dictionary có nhanh nhưng cũng chỉ nhỉnh hơn tí thôi:
- Với dữ liệu của tác giả, ta copy ra 60,000 dòng thì code dùng Collection ra kết quả trong vòng 0.26s, còn Dictionary ra kết quả trong vòng 0.23s
- Với dữ liệu 60,000 dòng KHÔNG TRÙNG, code dùng Collection ra kết quả trong vòng 0.57s, còn Dictionary ra kết quả trong vòng 0.53s
-------------------------
Dữ liệu càng ít trùng thì code càng chậm và ngược lại ---> Với Collection, ta phải dùng tí "mẹo" ---> Tham khảo thêm tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?27286-T%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng/page3

 

[Lê Duy Thương]

anh, chị nào biết công thức trả về danh sách các phần tử duy nhất trong một dãy thì giúp em với, cảm ơn nhiu nhiu

Thử dùng cái code tự chế xem có được không nhé

Private Sub CommandButton1_Click()
Sheets("sheet1").Range("C9:C60000").Copy
ActiveSheet.Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("E9:E60000").RemoveDuplicates Columns:=1
ActiveSheet.Range("E9").Select
End Sub

các bác thunghi-concogia-ndu... có đi qua thấy sai chổ nào thì chỉ giúp em nhé

 

[ndu96081631]

Thử dùng cái code tự chế xem có được không nhé

Private Sub CommandButton1_Click()
Sheets("sheet1").Range("C9:C60000").Copy
ActiveSheet.Range("E9").Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Range("E9:E60000").RemoveDuplicates Columns:=1
ActiveSheet.Range("E9").Select
End Sub

các bác thunghi-concogia-ndu... có đi qua thấy sai chổ nào thì chỉ giúp em nhé

Sai thì không... nhưng RemoveDuplicates chỉ dùng được với version từ 2007 trở đi ---> Excel 2003 trở xuống sẽ báo lỗi!
Lưu ý rằng cho dù ta đang sở hửu bộ Office 2007 đi nữa thì khi đụng đến chuyện LỌC DUY NHẤT cũng nên dùng AdvancedFilter ----> RemoveDuplicates chỉ dùng trong trường hợp LỌC TẠI CHỔ mà thôi, tức là XÓA DỮ LIỆU TRÙNG, không phải là LỌC SANG NƠI KHÁC
Nếu muốn dùng công cụ có sẳn, tôi đề xuất code thế này:

Private Sub CommandButton1_Click()
  Range("E:E").Clear
  Range("C9:C60000").AdvancedFilter 2, , [E9], True
End Sub

Sẽ dùng được trên Excel 2003 và cả Excel 2007
Nói thêm: Tuy code có gọn nhưng tốc độ cũng không thế nhanh bằng với Dictionary và Collection đâu

 

[Lê Duy Thương]

sai thì không... Nhưng removeduplicates chỉ dùng được với version từ 2007 trở đi ---> excel 2003 trở xuống sẽ báo lỗi!
Lưu ý rằng cho dù ta đang sở hửu bộ office 2007 đi nữa thì khi đụng đến chuyện lọc duy nhất cũng nên dùng advancedfilter ----> removeduplicates chỉ dùng trong trường hợp lọc tại chổ mà thôi, tức là xóa dữ liệu trùng, không phải là lọc sang nơi khác
nếu muốn dùng công cụ có sẳn, tôi đề xuất code thế này:

private sub commandbutton1_click()
range("e:e").clear
range("c9:c60000").advancedfilter 2, , [e9], true
end sub

sẽ dùng được trên excel 2003 và cả excel 2007
nói thêm: Tuy code có gọn nhưng tốc độ cũng không thế nhanh bằng với dictionary và collection đâu

hì i . Do em đang mày mò để tự học vba mà không có đến lớp nào cả
thấy bài #1 cuả bác tuấn yêu cầu bèn tìm cách nghiên cứu
nhưng thấy bác thu nghi nói nếu mới bập bẹ vào vba thì không nên dùng newcolection và dic. Nên dùng code có sẵn và chỉ nghiên cứu để tự học mà thôi
(CODE CỦA BÁC EM COPY VỀ THÌ KHÔNG CHẠY BÁC ƠI)
(bác ở biên hoà mà sao gặp bác khó quá, có phải bác đang làm ở gỗ tân mai không ?)

 

[ndu96081631]

hì i . Do em đang mày mò để tự học vba mà không có đến lớp nào cả
thấy bài #1 cuả bác tuấn yêu cầu bèn tìm cách nghiên cứu
nhưng thấy bác thu nghi nói nếu mới bập bẹ vào vba thì không nên dùng newcolection và dic. Nên dùng code có sẵn và chỉ nghiên cứu để tự học mà thôi

ThuNghi nói đúng đây! Nêu mới tập tành thì nên dùng phương pháp Record macro thu lại những thao tác mà ta đã làm, sau đó vào chỉnh lại code
Để code gọn hơn, ta sẽ xóa bớt những chổ có Select hoặc Selection. Ví dụ thế này:

Range("E9:E100").Select
Selection.Copy
Range("F9").Select
ActiveSheet.Paste

Đoạn này ta sẽ rút gọn thành:

Range("E9:E100").Copy Range("F9")

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

(bác ở biên hoà mà sao gặp bác khó quá, có phải bác đang làm ở gỗ tân mai không ?)

Tôi làm ở cty ChangShin bạn à (nhà cũng gần đó) ---> Muốn gì cứ nhắn tin riêng nhé!

 

[Lê Duy Thương]

ThuNghi nói đúng đây! Nêu mới tập tành thì nên dùng phương pháp Record macro thu lại những thao tác mà ta đã làm, sau đó vào chỉnh lại code
Để code gọn hơn, ta sẽ xóa bớt những chổ có Select hoặc Selection. Ví dụ thế này:

Range("E9:E100").Select
Selection.Copy
Range("F9").Select
ActiveSheet.Paste

Đoạn này ta sẽ rút gọn thành:

Range("E9:E100").Copy Range("F9")

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

CẢM ƠN NDU ĐÃ CHỈ GIÁO
XEM DỮ LIỆU CỦA TÁC GIẢ KHÔNG CÓ CT NÊN TÔI RÚT GỌN NHƯ SAU
COPY SANG SHEET KHÁC

Private Sub CommandButton1_Click()
Sheets("sheet1").Range("C9:C60000").Copy Sheets("sheet2").Range("E9")
Sheets("sheet2").Range("E8:E60000").RemoveDuplicates Columns:=1
End Sub
 
COPY TRONG SHEET
 
Private Sub CommandButton1_Click()
Sheets("sheet1").Range("C9:C60000").Copy Range("E9")
ActiveSheet.Range("E8:E60000").RemoveDuplicates Columns:=1
End Sub

 

[nhatviet3011]

Tôi có cách để lọc danh sách duy nhất đơn giản-Xin mọi người tham khảo
VDụ :
Có danh sách Công ty A, Cty B, CtyC ..........Cty X Với số dòng 100 .
Để lọc ra danh sách duy nhất ta có thể dùng Hàm IF.
Giả sử Fiels Tên Công ty là A1-Công ty A bắt đầu danh sách là từ A2 đến A10 (Danh sách này đã được sắp xếp trong khung Lits theo thứ tự) công ty B từ A11 đến A20 tương tự các cty khác tiếp theo.....
Tại B2 ta Viết Công thức Sau =IF(A2=A1,0,1) như vậy các giá trị duy nhất sẽ nhận giá trị là 1 ta chỉ cần lọc theo Điều kiện là 1 sẽ ra ngay.
Xin cảm ơn.
Doviethung

 

[bebo021999]

Tôi có cách để lọc danh sách duy nhất đơn giản-Xin mọi người tham khảo
VDụ :
Có danh sách Công ty A, Cty B, CtyC ..........Cty X Với số dòng 100 .
Để lọc ra danh sách duy nhất ta có thể dùng Hàm IF.
Giả sử Fiels Tên Công ty là A1-Công ty A bắt đầu danh sách là từ A2 đến A10 (Danh sách này đã được sắp xếp trong khung Lits theo thứ tự) công ty B từ A11 đến A20 tương tự các cty khác tiếp theo.....
Tại B2 ta Viết Công thức Sau =IF(A2=A1,0,1) như vậy các giá trị duy nhất sẽ nhận giá trị là 1 ta chỉ cần lọc theo Điều kiện là 1 sẽ ra ngay.
Xin cảm ơn.
Doviethung

Cám ơn bạn đã chia sẻ. Cách này tôi làm trước đây, nhưng bây giờ ít dùng. Trên thực tế, danh sách công ty có khi xếp lộn xộn, nếu thế bạn phải sort lại trước khi áp dụng công thức. Hiện nay, trên diễn đàn có rất nhiều giải pháp về vấn đề này, tôi chia sẻ 1 công thức tôi cho là ngắn và dễ áp dụng.
Giả sử từ A2:A100 là danh sách các công ty sắp xếp lộn xộn. Ta sẽ trích lọc danh sách duy nhất tại cột B.Tại B2 bạn sẽ nhập công thức mảng sau:

=INDEX($A$2:$A$100,MATCH(0,COUNTIF($B$1:B1,$A$2:$A$100),0))

Kết thúc bằng Ctrl-Shift-Enter.
Copy xuống đến khi báo lỗi.

 

[TrungChinhs]

Nếu dùng hàm để tạo mã lọc duy nhất thì tôi thường làm như sau: tại B2 nhập =COUNTIF(A$2:A2;A2) Fill xuống rồi Autofilter 1

Với =IF(A2=A1,0,1) thì dữ liệu như dưới đây lọc sẽ không đúng... ẹc...ẹc...
A
A
B
C
C
B
A
A
B
C

 

[Dauthivan]

Lọc như vầy còn nhanh gọn hơn nữa:

Sub Filter_Unique()
    Dim Src As Range, Des As Range
    Application.ScreenUpdating = False
    Set Src = Range("A5:A" & [A65536].End(xlUp).Row)
    [C5].CurrentRegion.ClearContents
    Src.AdvancedFilter Action:=2, CopyToRange:=[C5], Unique:=True
    Set Des = Range("C5:C" & [C65536].End(xlUp).Row)
    Des.Sort Key1:=Des(2), Order1:=1, Header:=1
    Application.ScreenUpdating = True
End Sub

Khỏi cần đặt name

Mừng quá, các bài toán khác em tìm trên diễn đàn từ sáng có vẻ như quá sức của em, bây giờ mới tìm ra được chủ đề này. Em nghĩ chủ đề này là một trong số các chủ đề rất phù hợp cho những người bắt đầu tìm tòi về VBA như em. Đa tạ các anh, chị, các thày nhiều.

 

[man231186]

Mình cũng có một bài toán muốn hỏi. Vấn đề khá giống vấn đề bạn tuan anh nêu ra nhưng phức tạp hơn. Đó là mình có khoảng 100 workshoot dữ liệu bên trong bị trộn lẫn các cột và dòng với nhau, nếu bỏ merge cell thì các ô sẽ có khoảng trống cả cột và cả dòng. Mình muốn trích lọc dữ liệu ra để xử lý. Không biết có cách nào không các bạn nhỉ?
Xin nhờ các pro xử lý giúp mình với, thank các bạn!

 

[trungvdb]

Vầy mới thật là "cực ngắn" đây:

Sub Filter_Unique()
  [E1].CurrentRegion.ClearContents
  Range([A1], [A65536].End(xlUp)).AdvancedFilter 2, , [E1], True
  [E1].CurrentRegion.Sort [E1], 1, Header:=1, DataOption1:=1
End Sub

Diển giãi:
- Dòng 1: Xóa sạch vùng dử liệu cột E trước khi lọc
- Dòng 2: Lọc duy nhất với dử liệu ở cột A, copy sang E1
- Dòng 3: Sort lại dử liệu sau khi lọc để loại bỏ các cell rổng
Đơn giản không? Tất cả đều tương đương với việc bạn làm bằng tay, dùng Advanced Filter và Sort (trên menu Data) ---> Chẳng qua ghi lại thành code cho nó tiện thôi

Bài này dùng VBA thì quả là có rất nhiều cách, ngoài cách trên em rất thích làm theo công thức, nhờ thày giúp cho cách viết Name điều kiện (tức là cụ thể hóa bước đánh dấu các dữ liệu cần lọc) viết thế nào ah?

 

[TrungChinhs]

Bài này dùng VBA thì quả là có rất nhiều cách, ngoài cách trên em rất thích làm theo công thức, nhờ thày giúp cho cách viết Name điều kiện (tức là cụ thể hóa bước đánh dấu các dữ liệu cần lọc) viết thế nào ah?

Thì làm như #53 và thêm If để không lấy các số >1
Ví dụ: =IF(COUNTIF($A$2:A2;A2)=1;"x";"")

 

[minhcong.tckt]

Có thể dùng lại biến thì viết như sau:

Sub Filter_Unique()
    Dim Src As Range
    Application.ScreenUpdating = False
    Set Src = Range("A1:A" & [A65536].End(xlUp).Row)
    [E1].CurrentRegion.ClearContents
    Src.AdvancedFilter Action:=2, CopyToRange:=[E1], Unique:=True
    Set Src = Range("E1:E" & [E65536].End(xlUp).Row)
    Src.Sort Key1:=Src(2), Order1:=1, Header:=1, DataOption1:=1
    Application.ScreenUpdating = True
End Sub

Diễn giải đơn giản như sau:

Sub Filter_Unique() |
Dim Src As Range | Tạo biến Src với tính chất là Range Application.ScreenUpdating = False | Đặt thuộc tính nạp lên mà hình là False Set Src = Range("A1:A" & [A65536].End(xlUp).Row) | Nạp dữ liệu vùng là từ A1 đến hết rồi đặt nó cho biến Src
[E1].CurrentRegion.ClearContents| Thực hiện việc xóa dữ liệu cho vùng tình từ E1 Src.AdvancedFilter Action:=2, CopyToRange:=[E1], Unique:=True | Thực hiện lệnh lọc Advanced Filter cho vùng này và copy nó sang vị trí E1 Set Src = Range("E1:E" & [E65536].End(xlUp).Row) | Nạp lại vùng từ E1 đến hết cho biến Src để Sort dữ liệu.
Src.Sort Key1:=Src(2), Order1:=1, Header:=1, DataOption1:=1 | Thực hiện Sort dữ liệu tăng dần ( Order:=1; với 1 = xlAscending ), và bỏ dòng đầu ( Header:=1 )
Application.ScreenUpdating = True | Trả lại giá trị trên màn hình
End Sub

Thân.

Bác cho em hỏi nếu chỉ muốn xóa Cột E thôi thì sửa code như thế nào
Vì các cột khác em có công thức ko muốn xóa

 

[ndu96081631]

Bác cho em hỏi nếu chỉ muốn xóa Cột E thôi thì sửa code như thế nào
Vì các cột khác em có công thức ko muốn xóa

Thì bạn cứ viết bình thường đi:
Range("E1:E60000").ClearContents
Hoặc
Range("E:E").ClearContents
Xong!

 

[minhcong.tckt]

Cảm ơn Bác nhiều, code của Bác làm file excel của em nhẹ hẳn đi, trước em dùng công thức nó nặng quá Chúc bác sức khỏe và thành đạt