Thiên Thanh
Yêu THVBA
Em hỏi lại anh chị giúp đỡ em nhé
Bạn cần đăng nhập để thấy link
Trời ạGiá trị trả về một mảng ấy hả, e rằng Excel 2013 của mình không giúp gì được rồi.
Cho dù viết ra một cái hàm có giá trị trả về là mảng thì máy tôi cũng không test được. Theo tôi biết office 365 thì ấn ctr shift enter, giá trị mảng sẽ lần lượt được ghi vào các ô liên tiếp.Trời ạ
Tại sao có những người chậm hiểu như ang vậy?
Excel không llamf được thì người ta mới cần viết hàm chứ.
VIP
Function sapxep(ParamArray arr() As Variant) As Variant
Dim r
Dim r1 As Range
Dim brr, crr
Dim s As String
Dim Dic As Object
Dim i As Long, sl As Long, cnt As Long
On Error GoTo thoat
For Each r In arr
If TypeOf r Is Range Then
For Each r1 In r
s = s & "," & r1.Value
Next r1
End If
Next r
s = Replace(s, ",,", ",", , , vbTextCompare)
If s = "" Then GoTo thoat
brr = Split(s, ",")
Set Dic = CreateObject("Scripting.Dictionary")
For i = LBound(brr) To UBound(brr) Step 1
s = CStr(brr(i))
If s <> "" Then
If Not Dic.Exists(s) Then
Dic.Add s, 1
Else
Dic.Item(s) = Dic.Item(s) + 1
End If
End If
Next i
brr = Dic.items
For i = LBound(brr) To UBound(brr) Step 1
sl = Application.WorksheetFunction.Large(brr, i + 1)
If Not Dic.Exists("@" & sl & "@") Then
Dic.Add "@" & sl & "@", 1
If cnt = 0 Then
cnt = cnt + 1
ReDim crr(1 To cnt)
Else
cnt = cnt + 1
ReDim Preserve crr(1 To cnt)
End If
crr(cnt) = sl
End If
Next i
ReDim brr(1 To cnt, 1 To 1)
For i = 1 To cnt Step 1
brr(i, 1) = crr(i)
Next i
sapxep = brr
Set Dic = Nothing
thoat:
End Function
VIP
=sapxep(a1,b5,a6:J17, Row(1$:z))
a1,b5,a6:J17
Row(1$:z)