Sub GhiSoThuTuCacTrang()
Dim Sh As Worksheet, Rng As Range, sRng As Range
Dim Col As Integer, W As Integer, Rws As Long, Max_ As Integer, Min_ As Integer, J As Long, Dm As Integer
Dim MyAdd As String
For Each Sh In ThisWorkbook.Worksheets
If IsNumeric(Right(Sh.Name, 1)) Then
Col = CInt(Right(Sh.Name, 1))
Rws = Sh.Cells(65500, Col).End(xlUp).Row
ReDim Arr(1 To Rws, 1 To 1) As String
Set Rng = Sh.Cells(2, Col).Resize(Rws)
Max_ = Application.WorksheetFunction.Max(Rng)
Min_ = Application.WorksheetFunction.Min(Rng)
For J = Min_ To Max_
Set sRng = Rng.Find(J, , xlFormulas, xlWhole)
' Dm = 0
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
Dm = Dm + 1: W = W + 1
Arr(sRng.Row - 2, 1) = CStr(Dm) & "/" & sRng.Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Dm = 0
Next J
End If
If W Then
Sh.Cells(3, "K").Resize(W).Value = Arr(): W = 0
End If
Next Sh
End Sub
