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àm AVERAGEIF (trả về giá trị trung bình cộng theo điều kiện) trong Excel

Hàm AVERAGEIF() giúp các bạn tính giá trị trung bình cộng của các ô dữ liệu với điều điện cho trước. Nếu bạn nào chưa biết cách sử dụng hàm thì các bạn có thể theo dõi bài viết dưới đây.

Bài viết hướng dẫn cú pháp và cách sử dụng hàm AVERAGEIF() trong Excel.

Mô tả

Hàm AVERAGEIF() trả về giá trị trung bình cộng của tất cả các ô được chọn thỏa mãn điều kiện mà các bạn chỉ định.

Cú pháp

=AVERAGEIF(range,criteria,average_range)

Trong đó:

- range: là một hoặc nhiều ô cần tính giá trị trung bình, range có thể là các con số, các tên vùng, các mảng hay các tham chiếu đến có chứa số.

- criteria: là điều kiện dưới dạng con số, biểu thức, tham chiếu ô hoặc văn bản xác định các ô sẽ tính giá trị trung bình.

- average_range: tập hợp các ô thực sự cần tính giá trị trung bình, nếu average_range bỏ trống thì range sẽ được dùng để tính giá trị trung bình.

Ghi chú

- Những ô trống trong average_range được bỏ qua.

- Trong range chứa những giá trị logic (TRUE hoặc FALSE) cũng được bỏ qua.

- Nếu range rỗng hoặc chứa chuỗi thì hàm AVERAGEIF() sẽ báo lỗi

. - Trong criteria chứa ô trống (rỗng), thì hàm sẽ xem nó bằng 0.

- Nếu không có ô nào trong range thỏa mãn điều kiện criteria thì hàm AVERAGEIF() báo lỗi.

- Các bạn có thể sử dụng các ký tự đại diện như dấu hỏi chấm (?) thay cho một ký tự nào đó, dấu sao (*) thay cho một chuỗi nào đó trong criteria. Khi điều kiện trong criteria là dấu ? hay dấu * thì các bạn gõ thêm dấu ~ trước nó.

- Average_range và range không nhất thiết phải cùng kích thước với nhau, các ô thực sự được tính trung bình sẽ dùng ô trên cùng bên trái của average_range làm ô bắt đầu, và bao gồm thêm các ô tương ứng với kích thước của range. Để hiểu rõ hơn các bạn xem ví dụ dưới đây:

Ví dụ

Ví dụ 1:

Ví dụ 2:

Hi vọng với hai ví dụ trên các bạn sẽ hiểu rõ hơn về cách sử dụng hàm AVERAGEIF() trong Excel. Chúc các bạn thành công!

7.Ví dụ: [Word Excel VBA] Cách xóa các dữ liệu trùng trên Excel trong một nốt nhạc - chỉ một nút bấm

Cách chọn nhiều ô trống trong trang tính Excel

1. Chọn những cột và hàng chứa ô trống cần điền.

2. Nhấn Ctrl + G hoặc F5, hộp thoại Go To xuất hiện.
3. Nhấp vào nút Button.

Chú ý. Nếu bạn không nhớ phím tắt, đến nhóm Editing tại thẻ HOME và chọn lệnh Go To Special từ danh sách tùy chọn Find & Select. Hộp thoại tương tự sẽ xuất hiện trên màn hình.

Lệnh Go To Special cho phép bạn chọn kiểu ô cụ thể như những ô chứa công thức, hằng số, ô trống…

4. Đánh dấu chọn Blanks và nhấn OK.

Bây giờ, chỉ những ô trống trong vùng dữ liệu đã chọn được bôi màu và sẵn sang cho thao tác tiếp theo.

Công thức Excel để điền giá trị vào ô trống

Sau khi chọn những ô trống từ bảng, bạn có thể điền giá trị của ô trên/dưới hoặc chèn nội dung cụ thể vào những ô đó.
Nếu bạn muốn điền giá trị từ ô trên/dưới vào ô trống, bạn cần nhập một công thức rất đơn giản vào một trong các ô trống. Sau đó sao chép chúng sang những ô trống khác.

1. Chọn tất cả các ô trống.
2. Nhấn F2 hoặc di chuyển con chuột lên thanh công thức để nhập công thức vào ô tính. Ví dụ, trong hình dưới đây, C4 là ô được chọn.
3. Gõ vào dấu “=”
4. Trỏ con chuột vào ô trên/dưới bằng phím mũi tên lên xuống hoặc nhấp vào ô đó.

Công thức (=C3) hiển thị trong ô tính C4 sẽ ra kết quả là giá trị của ô C3.

5. Nhấn Ctrl + Enter để sao chép công thức vào tất cả ô được chọn.

Chú ý. Bạn nên nhớ rằng tất cả các ô tính trống bây giờ đều được nhập công thức. Nếu bạn muốn giữ thứ tự trong bảng, tốt nhất là bạn hãy thay đổi các công thức thành giá trị. Hoặc, bạn có thể áp dụng cách phức tạp hơn là sắp xếp thứ tự (Sort) hay cập nhật thông tin cho bảng.

Điền vào ô trống giá trị “0” hoặc một giá trị cụ thể khác

Phương pháp 1

1. Chọn các ô trống.
2. Nhấn F2 để nhập giá trị vào một ô.

3. Gõ số hoặc nội dung bạn muốn vào ô.
4. Nhấn Ctrl + Enter.

Như vậy, tất cả các ô trống đều được điền giá trị bạn vừa nhập.
Phương pháp 2

1. Chọn vùng dữ liệu chứa các ô trống.

2. Nhấn Ctrl + H, hộp thoại Find & Replace hiện ra.
3. Di chuyển đến thẻ Replace trong hộp thoại.
4. Bỏ trống hộp Find what:, chỉ nhập giá trị cần thiết vào hộp Replace with:.

5. Nhấp vàp Replace All.

Giá trị bạn vừa nhập trong hộp Replace with: sẽ được điền tự động vào các ô trống.
Nguồn: Ablebits