36)
Public Function UniqueArray(ParamArray Source()) As Variant
...
ReDim TmpArr(1 To [COLOR=#ff0000]1000000[/COLOR], 1 To 1)
...
End Function
Sub test()
Dim arr
arr = UniqueArray([D5:I17], [L8:L11], [D21:D36])
Range("L13:L42").Value = arr
Debug.Print LBound(arr) & " - " & UBound(arr)
End SubBạn dùng công thức thì đúng thế.
Nếu bạn chạy sub test sau thì OK.
Tôi cũng nghĩ thế. Và xin mời tham khảo code sửa như sau:
[GPECODE=vb]
Public Function UniqueArray(ParamArray Source())
Dim SourceItem, SubItem, TmpArr
Dim Dict As Object, Tmp
Set Dict = CreateObject("Scripting.Dictionary")
For Each SourceItem In Source
Tmp = SourceItem
If Not IsArray(Tmp) Then Tmp = Array(Tmp)
For Each SubItem In Tmp
If Not IsEmpty(SubItem) And Not Dict.Exists(SubItem) Then
Dict.Add SubItem, ""
End If
Next
Next
UniqueArray = Application.WorksheetFunction.Transpose(Dict.Keys)
Set Dict = Nothing
End Function
Sub Bup()
Dim arr
arr = UniqueArray([D5:I17], [L8:L11], [D21
Range("L13").Resize(UBound(arr)).Value = arr
End Sub
[/GPECODE]
Public Function UniqueArray(ParamArray Source()) As Variant
Dim SourceItem As Variant, SubItem As Variant
Dim Dict As Object, n As Long, Tmp As Variant
Set Dict = CreateObject("Scripting.Dictionary")
For Each SourceItem In Source
Tmp = SourceItem
If Not IsArray(Tmp) Then Tmp = Array(Tmp)
For Each SubItem In Tmp
If Not IsEmpty(SubItem) And Not Dict.Exists(SubItem) Then
n = n + 1
Dict.Add SubItem, ""
End If
Next
Next
If n Then
Dim Arr, TmpArr As Variant, i As Long
Arr = Dict.Keys: n = n - 1
ReDim TmpArr(0 To n, 1 To 1)
For i = 0 To n
TmpArr(i, 1) = Arr(i)
Next
UniqueArray = TmpArr
End If
Set Dict = Nothing
End Function
