Sub TimSoThieuVaSoTrung()
Dim J As Long, Rws As Long, DD As Byte, Max_ As Long, Min_ As Long, Dem As Integer, Tmr As Double
Dim WF As Object, Rng As Range, sRng As Range
Dim MyAdd As String
Rws = [A2].End(xlDown).Row: Tmr = Timer()
Application.ScreenUpdating = False
For J = 2 To Rws
With Cells(J, "A")
If IsNumeric(.Value) Then
.Offset(, 1).Value = .Value
Else
DD = Len(.Value) - 1
.Offset(, 1).Value = CLng(Left(.Value, DD))
.Offset(, 2).Value = Right(.Value, 1)
End If
End With
Next J
Set WF = Application.WorksheetFunction: Set Rng = Range("B2:B" & Rws)
Min_ = WF.Min(Rng): Max_ = WF.Max(Rng)
Range("D2:E" & 2 * Rws).ClearContents: ReDim Arr(1 To 2 * Rws, 1 To 2)
For J = Min_ To Max_
Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
If sRng Is Nothing Then
W = W + 1: Arr(W, 1) = J
Arr(W, 2) = "Không có"
Else
MyAdd = sRng.Address: Dem = 0
Do
Dem = Dem + 1
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
If Dem > 1 Then
W = W + 1: Arr(W, 1) = J
Arr(W, 2) = "Trùng " & Dem & ".": Dem = 0
End If
End If
Next J
Application.ScreenUpdating = True
W = W + 1
Arr(W, 1) = Format(Timer() - Tmr, "###.###0")
Arr(W, 2) = "TG Tiêu Tôn"
[d2].Resize(W, 2).Value = Arr()
Range("B2:C" & Rws).ClearContents
End Sub
