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.
SQL này em thấy cũng hay nhưng chưa đụng đến .Làm báo cáo lấy dữ liệu cực kỳ nhanh.Các Bạn cố giắng mà học cách điền kết quả ra Sheet kiểu Office 365 đi sẻ rất hay đấy ... Ngay cả khi Bạn xài Office 365 mà một số hàm Bill không hổ trợ thì viết lấy mà xài cho khỏe VD như: xài ADO lấy dữ liệu file Access Or Excel thì viết ADO bình thường như những hàm khác xong truyền SQL vào gõ trên Cells cái cộp là xong .... Minh họa như hình sau ( làm biếng úp Video lắm )
Nếu kẹt nữa thì Atools cũng là 1 giải pháp tốt cho Bạn
View attachment 246257
Biết mà nếu nhớ ko lầm thì Bạn có nói 1 lần trên GPE rồi mà ở thớt khác
"Application.Caller"
If TypeName(Application.Caller) = "Range" Then
Chốc chốc lại thấy có anh gì lại úp quả vi đi ô rất là hoành trán nhưng không thấy mặt mũi cốt két thế nào? Bạn thử hỏi cách làm của anh ý xem.
Một bài toán nhiều phương án giải khác nhau đều sẽ có ưu nhược điểm riêng. Đối với bạn nó bình thường nhưng đối với mình thì nó cực kỳ hữu ích. Mình rất mong sự giải đáp từ bạn.
Bạn cứ bình tĩnh chờ đợi thêm các phương pháp như trong video của các anh ý đã, biết đâu được đến đó bạn sẽ thấy những cái đó hữu ích hơn rất nhiều.
Thôi đành ngậm ngùi vậy. Một chuyện tình dang dở.Bạn cứ bình tĩnh chờ đợi thêm các phương pháp như trong video của các anh ý đã, biết đâu được đến đó bạn sẽ thấy những cái đó hữu ích hơn rất nhiều.
Mình cũng đan chờ đợi những cái đó giống như cảm giác của bạn vậy
Tôi thấy có gì đáng buồn cười đâu.đọc Comment của bạn không nhịn được cười
xem thử vi deo của 1 bạn dấu tên xem có nghiệm ra được gì không
Cái này nó cũng co dãn được tẹo
Cái này bạn có thể ứng dụng nó viết ra đầy thứ như ai đấy
