Dạ, em cám ơn," Ba Tê" rất ngon cho bữa trưa ạ!
Dạ, thầy ơi, sao file của em nó vẫn lỗi, không xếp đúng ạ, cái cột B của em nó lộn xộn ạ, tại công việc của em là nó gối nhau ạ, lúc làm hạng mục này, lúc làm hạng mục khác thầy ạ!
Sub DanhSoThuTuTheoNgay()
Dim WF As Object, Rng As Range, sRng As Range
Dim J As Long, fDat As Date, lDat As Date, SoNgay As Integer, Dat As Date
Dim MyAdd As String
Const Alf As String = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Set WF = Application.WorksheetFunction
Set Rng = Range([B2], [B2].End(xlDown))
Rng.NumberFormat = "MM/DD/yyyy"
fDat = WF.Min(Rng): lDat = WF.Max(Rng)
SoNgay = lDat - fDat
For J = 0 To SoNgay
Dat = fDat + J
Set sRng = Rng.Find(Format(Dat, "MM/DD/yyyy"), , xlValues, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
sRng.Offset(, -1).Value = (Year(Dat) - 2010) * 10 ^ 4 + Month(Dat) * 100 + Day(Dat)
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Next J
End Sub
Thử.
Sub sapxep()
Dim arr, kq, i As Long, dk As Long, lr As Long, olit As Object, R As Long, a As Long
Set olit = CreateObject("System.Collections.SortedList")
With Sheets("sheet1")
lr = .Range("B" & Rows.Count).End(xlUp).Row
If lr = 1 Then Exit Sub
arr = .Range("b2:C" & lr).Value
R = UBound(arr)
ReDim kq(1 To R, 1 To 1)
For i = 1 To R
dk = CLng(arr(i, 1))
If Not olit.Contains(dk) Then
olit.Add dk, i
End If
Next i
For i = 1 To R
dk = CLng(arr(i, 1))
a = olit.IndexOfKey(dk)
kq(i, 1) = a + 1
Next i
.Range("A2:A" & lr).Value = kq
End With
End SubEm cám ơn nhiều ạ, code chạy chuẩn luôn ạ!
Em xin cảm ơn ạ. E chúc thầy và gia đình mạnh khỏe để tiếp tục giúp đỡ bọn em ạ
