Xin giúp code xóa số trùng và tìm số còn thiếu

[hoang0569]

Minh gửi Fie, các bạn giúp nhé, xin cảm ơn

 

[SA_DQ]

Bạn chạy thử con này:

Sub XoaTrungVaTimThieu()
 Dim J As Integer, W As Integer, Dong As Integer
 Dim Rng As Range, sRng As Range
 Dim MyAdd As String
 
 Set Rng = [C3].CurrentRegion:          Dong = 2
 For J = 0 To 9
    W = 0
    Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Dong = Dong + 1:                Cells(Dong, "E").Value = J
    Else
        MyAdd = sRng.Address
        Do
            W = W + 1
            If W > 1 Then sRng.Value = Space(0)
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next J
End Sub

 

[CHAOQUAY]

Minh gửi Fie, các bạn giúp nhé, xin cảm ơn

Thêm 1 cách tham khảo. Kết quả điền vào cột D & E

Sub Loc_()
Dim Nguon
Dim LoaiTrung(1 To 10, 1 To 1) As Integer
Dim SoThieu
Dim rws, i, j, k
Nguon = Sheet1.Range("C3", Sheet1.Range("C3").End(xlDown))
rws = UBound(Nguon)
SoThieu = Split("0 1 2 3 4 5 6 7 8 9")
For i = 1 To rws
    j = CLng(Nguon(i, 1))
    If SoThieu(j) <> "" Then
        k = k + 1
        LoaiTrung(k, 1) = j
        SoThieu(j) = ""
    End If
Next i
SoThieu = Split(WorksheetFunction.Trim(Join(SoThieu)))
With Sheet1
    .Range("D3:D" & rws + 2).ClearContents
    .Range("D3").Resize(k, 1) = LoaiTrung
    .Range("E3:E" & rws + 2).ClearContents
    .Range("E3").Resize(10 - k, 1) = WorksheetFunction.Transpose(SoThieu)
End With
End Sub

 

[hoang0569]

Rất cảm ơn các anh chị