Giúp em cách dò tìm, loại bỏ số trùng

[sokotui]

Em có 1 dãy số, trong đó có nhiều số trùng nhau.
Em phải làm sao để có 1 cột số theo thứ tự mà không có những con số trùng lặp.
Mọi người giúp em với.
Cảm ơn

 

[boyxin]

Em có 1 dãy số, trong đó có nhiều số trùng nhau.
Em phải làm sao để có 1 cột số theo thứ tự mà không có những con số trùng lặp.
Mọi người giúp em với.
Cảm ơn

Bạn thử với đoạn code này xem sao

Sub GPE_boyxin()
Dim Tmp As Variant, Rng As Range
[L1].CurrentRegion.ClearContents
Set Rng = [A1].CurrentRegion
Tmp = [L1:L9999]
n = 0
For i = 0 To WorksheetFunction.Max(Rng)
If WorksheetFunction.CountIf(Rng, i) > 0 Then
n = n + 1
Tmp(n, 1) = i
End If
Next
[L1:L9999] = Tmp
MsgBox "Trong vung " & Rng.Address & " co " & n & " so khac nhau."
[M6] = "Co " & n & " so khac nhau."
End Sub

 

[sealand]

Cái này đã dùng Code thì dùng Scripting Dictionary nhanh và hiệu quả hơn Boyxin à. Bạn kiểm ttra nhé

Sub LocDS()
Dim Rng, Cll As Range
Sheet1.Columns("M:N").ClearContents
Application.ScreenUpdating = False
Set Rng = Sheet1.[a1].CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For Each Cll In Rng.Cells
If Not d.Exists(Cll.Value) Then d.Add Cll.Value, Nothing
Next
MsgBox "Trong vung " & Rng.Address & " co " & d.Count & " so khac nhau."
[n6] = "Co " & d.Count & " so khac nhau."
a = d.Keys
For i = 0 To d.Count - 1
Sheet1.Cells(i + 1, 13) = a(i)
Next
Sheet1.Range("M1:M" & d.Count).Sort [M1], xlAscending
End Sub

 

[ndu96081631]

Cái này đã dùng Code thì dùng Scripting Dictionary nhanh và hiệu quả hơn Boyxin à. Bạn kiểm ttra nhé

Sub LocDS()
Dim Rng, Cll As Range
Sheet1.Columns("M:N").ClearContents
Application.ScreenUpdating = False
Set Rng = Sheet1.[a1].CurrentRegion
Set d = CreateObject("Scripting.Dictionary")
For Each Cll In Rng.Cells
If Not d.Exists(Cll.Value) Then d.Add Cll.Value, Nothing
Next
MsgBox "Trong vung " & Rng.Address & " co " & d.Count & " so khac nhau."
[n6] = "Co " & d.Count & " so khac nhau."
a = d.Keys
For i = 0 To d.Count - 1
Sheet1.Cells(i + 1, 13) = a(i)
Next
Sheet1.Range("M1:M" & d.Count).Sort [M1], xlAscending
End Sub

Anh ơi, 1 vòng lập là đủ rồi ---> anh đã Add vào Dictionary Object rồi thì hoàn toàn có thể lấy ra mà không cần thêm vòng lập nào

Sub LocDS()
  Dim Rng, Cll As Range
  Sheet1.Columns("M:N").ClearContents
  Set Rng = Sheet1.Range("A1").CurrentRegion
  With CreateObject("Scripting.Dictionary")
    For Each Cll In Rng
      If Not .Exists(Cll.Value) Then .Add Cll.Value, ""
    Next
    MsgBox "Trong vung " & Rng.Address & " co " & .Count & " so khac nhau."
    [n6] = "Co " & .Count & " so khac nhau."
    Sheet1.Range("M1").Resize(.Count).Value = WorksheetFunction.Transpose(.Keys)
    Sheet1.Range("M1").Resize(.Count).Sort [M1], 1
  End With
End Sub

Em dùng Transpose anh à!