Sub Locgiatritrung()
Dim sRng As Range, Rng As Range
Dim sArr, dArr, I As Long
Dim Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
On Error GoTo Thoat
Set sRng = Application.InputBox(Prompt:="Chon vung du lieu ", Title:="Chon vung", Type:=8)
sArr = sRng.Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
Tem = sArr(I, 1)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
dArr(K, 1) = Tem
End If
Next I
Set Rng = Application.InputBox(Prompt:="Chon 1 o chia du lieu ", Title:="Ket qua", Type:=8)
If K Then Rng.Resize(K, 1) = dArr
Thoat:
Set Dic = Nothing
End Sub
Bạn chép code vào module rồi chạy thử, mượn tạm code của bạn
@PacificPR .