Nếu bạn dùng phiên bản office 365 thì thậm chí bạn không cần làm gì cả, tự nhiên nó được vậy thôi
Function UNIQUE(Rng As Range)
Dim Arr As Variant, Cls As Range
Dim J As Long, K As Long, W As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
ReDim Arr(1 To 2 * Rng.Cells.Count, 1 To 1)
For Each Cls In Rng
J = J + 1
If Not dic.exists(Cls.Value) Then
dic.Add Cls.Value, J
W = W + 1: Arr(W, 1) = Str(Cls.Value)
End If
Next
UNIQUE = Arr()
End FunctionKhông phải vậy đâu sư phụ à. Ý người ta là làm sao cho nó tự động fill công thức mảng kìa. Như trong video, em gõ công thức vào 1 cell, enter phát là nó tự fill xuống đến hết mà không cần phải quét chọn trước vùng chứa kết quả (mà dù có quét cũng không biết phải quét bao nhiêu ô là đủ)
Loại hàm mảng này tôi đã từng giải thíchn cách dùng rồi.
Tìm trên diễn đàn nha, trước đây mình có làm thử theo file trên diễn đàn, chạy chậm quá nên xóa mất
Bạn kiểm tra thử xem,
Option Explicit
Public RangesToExpand As New Collection
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim oneCell As Range
Dim strFormula
Application.EnableEvents = False
For Each oneCell In RangesToExpand
With oneCell
strFormula = .Cells(1, 1).FormulaArray
.CurrentRegion.ClearContents
.FormulaArray = strFormula
RangesToExpand.Remove .Address(, , , True)
End With
Next oneCell
Application.EnableEvents = True
End SubFunction UNIQUES_COL(rng As Range) As Variant()
Dim list As New Collection
Dim Ulist() As Variant
Dim Value, i As Long
On Error Resume Next
For Each Value In rng
list.Add CStr(Value), CStr(Value)
Next
On Error GoTo 0
ReDim Ulist(list.Count - 1, 0)
For i = 0 To list.Count - 1
Ulist(i, 0) = list(i + 1)
Next
If TypeName(Application.Caller) = "Range" Then
If Application.EnableEvents Then
With Application.Caller
If .Rows.Count <> i Or .Columns.Count <> 1 Then
If ThisWorkbook.RangesToExpand Is Nothing Then
Set ThisWorkbook.RangesToExpand = New Collection
End If
With .Resize(i, 1)
ThisWorkbook.RangesToExpand.Add item:=.Cells, Key:=.Address(, , , True)
End With
End If
End With
End If
End If
UNIQUES_COL = Ulist
End Function=UNIQUES_COL($A$1:$A$13)
TransposeArray = ResizeArray(Total)Mình đã text thử ok đó.
Bác nhớ từ khóa tên gì không em muốn kham khảo.
Em nhầm, bác Quote nhanh quá, em đang xài 365 nên có cái hàm này
Bạn thử lấy code phía trên bỏ vô module chạy.Gõ vào 1 ô thì tự điền công thức giống như hàm unique 365
Dạ đúng rồi này phải xoá luôn 1 mảng.
