Lọc và lấy các giá trị không trùng Code VBA

Filter and get the unique values - Lọc và lấy các giá trị không trùng Code VBA

1. Sử dụng Collection/Use Collection:

Mã:

Sub FilterUniqueNumbers()
    Dim rngYourrange As Range
    Dim rngCell As Range
    Dim colUniqueNumbers As New Collection
    Dim i As Integer

    ' Set the range that you want to filter for unique numbers
    Set rngYourrange = Worksheets(1).Range("A1:A10")

    ' Store the unique range values in the collection object. Note we use the
    ' range value converted to a string as the key value.
    On Error Resume Next
    For Each rngCell In rngYourrange
        colUniqueNumbers.Add rngCell.Value, CStr(rngCell.Value)
    Next rngCell

    ' Write each item from the collection object to column B in worksheet 1.
    For i = 1 To colUniqueNumbers.Count
        Worksheets(1).Cells(i, 2).Value = colUniqueNumbers(i)
    Next i
End Sub

2. Dùng AdvancedFilter/Use AdvancedFilter:

Mã:

Sub FilterUniqueNumbers2()
    Dim rngDuplicates As Range
    Dim rngDestination As Range
    Dim rngCriteria As Range
    
    ' Filter entire column A, or use Range("A1:A10") or something to check only 10 rows.
    Set rngDuplicates = ThisWorkbook.Worksheets(1).Range("A:A")


    Set rngDestination = ThisWorkbook.Worksheets(1).Range("B1")
    Set rngCriteria = ThisWorkbook.Worksheets(1).Range("C1:C5")

    rngDuplicates.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, _
            CopyToRange:=rngDestination, Unique:=True
End Sub

3. Dùng scripting.dictionary/Use Scripting.Dictionary object:

Mã:

Sub FilterUniqueNumbers3()
    Dim vValue As Variant, vVals As Variant
    Dim myRange As Range
    Dim i As Long
    Dim dArr() As Double
    Dim oDic As Object
    
    Set myRange = Worksheets(1).Range("A1:A10")

    'The Dictionary object is always present in Windows so it can always be created
    Set oDic = CreateObject("scripting.dictionary")
    oDic.comparemode = vbTextCompare

    'Đọc giá trị từ một vùng đưa vào  vVals
    vVals = myRange.Value

    'Khai báo mảng 2 chiều: [COLOR="Blue"]ReDim dArr[/COLOR], chú ý tham số thứ hai là [COLOR="Blue"]1 To 1[/COLOR]
    'Như vậy sau này bạn mới có thể đưa vào worksheet.
    ReDim dArr(UBound(vVals) - 1, 1 To 1)
    
    For Each vValue In vVals
        'Chỉ đưa vào những giá trị [COLOR="Blue"]không rỗng[/COLOR] và [COLOR="Blue"]chưa có trong oDic[/COLOR]
        If Not IsEmpty(vValue) And Not oDic.exists(vValue) Then
            dArr(i, 1) = vValue
            oDic.Add vValue, Nothing
            i = i + 1
        End If
    Next vValue

    'Giải phóng bộ nhớ được dùng bởi [COLOR="Blue"]Dictionary object[/COLOR] và [COLOR="Blue"]vVals[/COLOR]
    Set oDic = Nothing
    Erase vVals

    'Xóa vùng dữ liệu cũ
    myRange.Clear

    'Đưa các giá trị từ [COLOR="Blue"]dArr[/COLOR] vào worksheet
    myRange.Resize(i).Value = dArr
End Sub

Cú pháp Dictionary:
(Phần giải thích của ndu96081631)
Cú pháp đưa dữ liệu cho Dictionary là:

Mã:

Dic.Add Key, Item

• Mỗi lần nạp như vậy thì Key sẽ được cho vào nhóm Keys và Item sẽ được cho vào nhóm Items
• Item: có thể là bất cứ giá trị gì nhưng Key bắt buộc phải là những phần tử không trùng nhau trong nhóm Keys ---> Và ta áp dụng tính chất này của Dictionary để lấy unique list (danh sách không trùng)
• Nếu không muốn Add giá trị cho Item thì có thể viết thế này:
  Mã:

  Dic.Add Key,""

  Đây thuộc về cú pháp (quy định) nên dù muốn hay không cũng phải viết cho đầy đủ! Thế thôi!
  (bạn đặc biết lưu ý: Key khác với Keys và Item khác với Items nha)

4. Viết Class module/Use class module:

Mã:

Sub ExtractItems()

    Dim clsExtract As CUniqueItems
    Dim rngSel As Range, rngTar As Range
   
    Set clsExtract = New CUniqueItems
    Set rngSel = Selection
    Set rngTar = ThisWorkbook.Sheets("Sheet2").Range("A1")
   
    clsExtract.TheSelection = rngSel
    clsExtract.Target = rngTar
    clsExtract.ExtractUniques
   
End Sub

Class module

Mã:

'********************************
' Class module code
'********************************
Option Explicit

' Class constants
Private Const msTAB As String = vbTab

' Class variables
Private mrSelection As Range
Private mrTarget As Range

' Class Properties
'   Selection
Property Get TheSelection() As Range
    Set TheSelection = mrSelection
End Property
Property Let TheSelection(rng As Range)
    Set mrSelection = rng
End Property

'   Target
Property Get Target() As Range
    Set targert = mrTarget
End Property
Property Let Target(rng As Range)
    ' The target can only be one cell, so if more than
    ' one cell is chosen, set the range to the
    ' upper leftmost cell.
    If rng.Count> 1 Then
        Set mrTarget = rng.Cells(1, 1)
    Else
        Set mrTarget = rng
    End If
End Property

' Class methods

Sub ExtractUniques()
   
    ' Variable declarations
    Dim rngCell As Range
    Dim col As Collection
    Dim iColCnt As Integer, i As Integer
    Dim vValue As Variant
   
    ' Create a new collection.
    Set col = New Collection
   
    ' Get the number of columns in the range
    iColCnt = mrSelection.Columns.Count
    ' If the column count is greater than 1, resize it to 1 column.
    If iColCnt> 1 Then Set mrSelection = mrSelection.Resize(, 1)
   
    ' Turn off updating.
    Application.ScreenUpdating = False

    ' Add each unique item to the collection.
    For Each rngCell In mrSelection.Cells
        vValue = ""
        ' If the column count is great than one, add the whole
        ' row of data in teh selected range. We'll split it out
        ' later.
        If iColCnt> 1 Then
            For i = 0 To iColCnt - 1
                ' Add all the data from the selected rows to the variable,
                ' separating them by a tab.
                vValue = vValue & rngCell.Offset(0, i).Value & msTAB
            Next i
        Else
            vValue = rngCell.Value
        End If
        ' Temporarily turn off error handling.
        On Error Resume Next
        ' Add to the collection.
        col.Add CStr(vValue), CStr(vValue)
        ' Turn error handling back on.
        On Error GoTo 0
    Next rngCell
   
    ' Write the data back out to the target.
    i = 1
    For i = 1 To col.Count
        mrTarget.Offset(i - 1, 0).Value = col(i)
    Next i
   
    ' If the selection column count is greater than 1,
    ' then convert the output text to multiple columns
    ' using text to columns.
    If iColCnt> 1 Then
        mrTarget.Parent.Activate
        mrTarget.Select
        Range(Selection, Selection.Offset(col.Count - 1, 0)).Select
        Selection.TextToColumns Destination:=Range(Selection.Address), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False
    End If
   
    ' Turn on updating and kill the collection object.
    Application.ScreenUpdating = True
    Set col = Nothing
       
End Sub

5. Sử dụng Array/Use array:

Mã:

Sub enkel()
  Dim sq As Variant
  Dim j As Long
 
  If Selection.Columns.Count = 1 Then
    sq = Application.WorksheetFunction.Transpose(Selection.SpecialCells(xlCellTypeConstants))
    For j = 1 To UBound(sq)
      sq=split(replace("|" & join(sq,"|") & "|","|" & sq(j) & "|","") & "|" & sq(j),"|")
    Next
    Sheets(1).[K1].Resize(UBound(sq) + 1) = Application.WorksheetFunction.Transpose(sq)
  End If
End Sub

6. Dùng FIND/Use Find method:

Mã:

Option Explicit
Sub OnlyOne()
 Dim eRw As Long, Ff As Long:               Dim myAdd As String
 Dim Rng As Range, sRng As Range
 eRw = [A65500].End(xlUp).Row:            ReDim DaCo(2 To eRw) As Boolean
 For Ff = 2 To eRw
    Set Rng = Range("A" & Ff + 1 & ":A" & eRw)
    If Not DaCo(Ff) Then
        Set sRng = Rng.Find(what:=Cells(Ff, "A"), LookIn:=xlFormulas, lookat:=xlWhole)
        If Not sRng Is Nothing Then
            myAdd = sRng.Address
            If DaCo(sRng.Row) = False Then
                Do
                    DaCo(sRng.Row) = True
                    Set sRng = Rng.FindNext(sRng)
                Loop While Not sRng Is Nothing And sRng.Address <> myAdd
            End If
        Else
            [c65500].End(xlUp).Offset(1) = Cells(Ff, "A").Value
    End If:         End If
 Next Ff
End Sub

7. Dùng WorksheetFunction.CountIf/Use WorksheetFunction.CountIf:

Mã:

Sub OnlyOne()
  Dim Clls As Range
  With Range([A2], [A65536].End(xlUp))
    For Each Clls In .SpecialCells(2, 23)
      If WorksheetFunction.CountIf(.Cells, Clls) = 1 Then
        [C65536].End(xlUp).Offset(1) = Clls
      End If
    Next
  End With
End Sub

8. Nếu dùng công thức/If you use formula

Giá trị ở A1:A30/Values in A1:A30

Ở B1 đặt giá trị 1/In B1 put value 1
Ở B2 đặt công thức/In B2 put the formula:

Mã:

=IF(ISERROR(MATCH(A2;$A$1:A1;0));MAX(B$1:B1)+1;”")

Copy công thức đến ô B30/Copy formula down till B30

Ở C1 đặt giá trị 1/In C1 put the value 1
Ở C2 đặt công thức =C1+1/In C2 the formula =C1+1

Ở D1 đặt công thức/In D1 the formula:

Mã:

=INDEX(A$1:A$30;MATCH(C1;$B$1:$B$30;0))

Copy xuống D2/Copy to D2

Bây giờ copy C22/Now copy C22 down…

Cột D bạn có các giá trị không trùng của A1:A30/In column D you have the A1:A30 unique values

9. Đâu là cách nhanh nhất?/Which one is faster?

Được thử bởi Hans Schraven
Được thử với danh sách có 8000 chuổi ký tự.
Tốc độ thực hiện tst1:tst2:tst3:tst4 = 1:23:55:112

Mã:

Sub tst1()
  Dim t As Long, i As Long, c0 As String
   
  t = Timer
  Columns(1).SpecialCells(xlCellTypeConstants).AdvancedFilter xlFilterCopy, , [K1], True
  Debug.Print Timer - t
End Sub

Sub tst2()
  Dim t As Long, i As Long, c0 As String

  t = Timer
  Set colUnique = New Collection
  On Error Resume Next
  For Each cl In Columns(1).SpecialCells(xlCellTypeConstants)
    colUnique.Add cl, Format(cl)
  Next
  On Error GoTo 0
   
  i = 0
  For Each it In colUnique
    Range("G1").Offset(i, 0).Value = it
    i = i + 1
  Next
  Debug.Print Timer - t
End Sub

Sub tst3()
  Dim t As Long, i As Long, c0 As String
  t = Timer
  sq = Application.WorksheetFunction.Transpose(Columns(1).SpecialCells(xlCellTypeConstants))
  For i = 1 To UBound(sq)
    If InStr("#" & c0, "#" & sq(i) & "|") = 0 Then c0 = c0 & sq(i) & "|#"
  Next
  sq = Split(c0, "|#")
  Cells(1, 4).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
  Debug.Print Timer - t
End Sub

Sub tst4()
  Dim t As Long, i As Long, c0 As String
   
  t = Timer
  sq = Split("|" & Join(Application.WorksheetFunction.Transpose(Columns(1).SpecialCells(xlCellTypeConstants)), "|#|") & "|", "#")
  For i = 0 To UBound(sq)
    If UBound(Filter(sq, sq(i))) > 0 Then sq(i) = "#"
  Next
  sq = Split(Replace(Join(Filter(sq, "#", False), "#"), "|", ""), "#")
  Cells(1, 4).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
  Debug.Print Timer - t
End Sub

Hướng dẫn lọc Email, Phone, Website bị trùng trong Excel 2010 cực nhanh

Hướng dẫn lọc Email, Phone, Website bị trùng trong Excel 2010 cực nhanh

Hôm nay mình xin hướng dẫn các bạn cách lọc Email, Hoặc Số phone, Website,.. nói chung là file bị trùng nằm trên cùng 1 cột mà bạn muốn loại bỏ nhanh để tránh trùng lập.
Bước 1: mở File Excel bị trùng lên, sau đó bấm vào cột A, để chọn toàn bộ
(mình sẽ gửi kèm theo danh sách email để các bạn test ở phần cuối)

Bước 2: bạn chọn qua Tab Data, trong tab này có phần Remove Duplicates, bạn chọn vào phần này.

Đây là thông báo hiển thị sau khi bạn chọn vào tính năng Remove Duplicates
Bước 3: Bạn chọn OK thì có thể loại bỏ toàn bộ các từ bị trùng lập. Kết quả như sau

Bạn chọn Ok và kiểm tra lại nhé. Rất dễ làm đúng không nào.
Chúc các bạn thành công nhé

Danh sách Email test:

vpt.ticketing@gmail.com ccss@yahoo.com.vn zi_dai_gia_hp@yahoo.com tung@yahoo.com thainguyen7557@yahoo.com ph0ngb4tjnhd0j@yahoo.com mai.luong83@yahoo.com keaxu_kiemtien@yahoo.com dungxd2001@gmail.com buonbanuytinh@yahoo.com boy_depzaj_sanhdieu97@yahoo.com lover_chocolater@yahoo.com.vn trancuong_vanphu@yahoo.com b0yhacker_yeugjrlstyle_92@yahoo.com con_duong_la_do_em_chon_hp2007@yahoo.com anhdola@yahoo.com haiphong01_babylon@yahoo.com nangha83@yahoo.com cay_thanh_gia_co_don@yahoo.com buonbanuytinh@yahoo.com boy_depzaj_sanhdieu97@yahoo.com lover_chocolater@yahoo.com.vn trancuong_vanphu@yahoo.com b0yhacker_yeugjrlstyle_92@yahoo.com con_duong_la_do_em_chon_hp2007@yahoo.com anhdola@yahoo.com haiphong01_babylon@yahoo.com

Lọc dữ liệu PivotTable report trong Excel

Bài viết dưới đây hướng dẫn chi tiết tới các bạn cách lọc dữ liệu PivotTable reports trong Excel 2013 một cách chính xác và nhanh nhất.

Báo cáo PivotTable ban đầu tạo ra theo yêu cầu giúp bạn xem toàn bộ thông tin của dữ liệu. Trường hợp bạn muốn thống kê dữ liệu theo 1 field nào đó bạn có thể sử dụng cách lọc dữ liệu để biết chính xác thông tin mình đang cần.

Bạn đã tạo ra 1 báo cáo hoàn chỉnh:

Nhưng do yêu cầu công việc bạn cần thống kê theo một số tiêu chí để đưa ra định hướng bán hàng -> sử dụng tính năng lọc dữ liệu trong PivotTable.

1. Lọc để xem 1 trong nhiều nhân viên bán hàng.

Ví dụ để lọc dữ liệu báo cáo theo nhân viên bán hàng và những nhân viên này mặc định được sắp xếp theo thứ tự giảm dần của doanh thu.

Bước 1: Nhấn chuột phải vào tên trường người bán hàng -> Add to Report Filter.

Bước 2: Sau khi lựa chọn xong trường cần lọc -> dữ liệu trong báo cáo thay đổi theo nhân viên bán hàng, đồng thời trường người bán hàng được thêm vào danh sách lọc FILTERS.

Bước 3: Bây giờ bạn muốn hiển thị chi tiết thông tin về 1 người bán hàng nào đó làm như sau: Di chuyển lên phía trên của báo cáo kích chọn vào mũi tên -> danh sách nhân viên được hiển thị -> lựa chọn tên nhân viên muốn biết thông tin -> kích chọn OK.

Bước 4: Sau khi kích chọn OK -> toàn bộ thông tin chi tiết về nhân viên được hiển thị:

- Nếu bạn muốn hiển thị tất cả nhân viên thay vì kích chọn tên nhân viên bạn kích chọn All.

2. Tìm ra những nhân viên bán được doanh thu cao trong bảng dữ liệu.

Bước 1: Add trường doanh thu vào hộp thoại ROWS bằng cách: Chuột phải vào tên trường -> chọn Add to Row labels.

Bước 2: Kích chuột vào mũi tên trong Row Labels -> Value Filters -> Greater Than Or Equal To (hoặc có thể lựa chọn kiểu sắp xếp khác tùy mục đích của bạn):

Bước 3: Hộp thoại Value Filter (id) xuất hiện nhập giá trị cần so sánh. Ví dụ ở đây tìm nhân viên có doanh thu lớn hơn hoặc bằng 4391500 -> kích chọn OK.

Sau khi chọn OK -> những nhân viên có doanh thu lớn hơn hoặc bằng 43915000 được hiển thị trên báo cáo, những nhân viên có doanh thu nhỏ hơn không được hiển thị.

3. Lọc thông tin theo thời gian.

Để lọc thông tin theo thời gian các bạn cần chú ý vấn đề sau:

+ Kiểu dữ liệu ngày phải được định dạng ở dạng ngày tháng mà Excel 2013 hỗ trợ.

+ Nên Add trường ngày vào Cột cho khoa học.

Bước 1: Chuột phải vào trường ngày -> Add to Column Labels:

Bước 2: Kích chuột vào mũi tên của Column Labels -> Date Filters -> Between (hoặc bạn có thể lựa chọn kiểu so sánh khác tùy mục đích):

Bước 3: Nhập giá trị ngày trong khoảng thời gian muốn thống kê -> nhấn OK:

- Sau khi nhấn OK được kết quả:

4. Hủy bỏ bộ lọc.

Để hủy bỏ bộ lọc bạn cần xóa trong cả 2 bộ phận của PivotTable reports.

- Xóa bỏ bộ lọc trong PivotTable:

Với bộ lọc theo hang hay theo cột thao tác tương tự: Kích chuột vào biểu tượng mũi tên Column Labels -> Clear Filter From “Ngày”

- Xóa bỏ bộ lọc trong PivotTable Filed List:

Kích chuột vào biểu tượng bộ lọc bên cạnh tên trường -> Clear Filter From “Ngày”

Với 2 thao tác trên bạn đã hủy bỏ được bộ lọc trong PivotTable.

5. Hủy bỏ 1 filter trong báo cáo PivotTable.

Trường hợp bạn không tìm thấy Clear Filter From để hủy bỏ bộ lọc trong Filter hoặc bạn muốn xóa hết tất cả mọi bộ lọc trong PivotTable làm thao tác sau: Kích chuột vào PivotTable -> di chuyển tới ANALYZE -> Action -> Clear -> Clear Filters:

Trên đây là hướng dẫn chi tiết cách lọc dữ liệu trong PivotTable trong Excel 2013.

Chúc các bạn thành công!