Sub CacNgayThieu()
Dim Rng As Range, sRng As Range, Cls As Range, WF As Object
Dim Dat As Date
Dim MyFormat As String
With Sheet2
Set Rng = .Range(.[A1], .[A1].End(xlDown))
MyFormat = Rng.NumberFormat
Rng.NumberFormat = "MM/DD/yyyy"
End With
Sheet1.Select
For Each Cls In Range([A1], [A65500].End(xlUp))
If Cls.Value <> "" Then
Dat = Format(Cls.Value, "MM/DD/yyyy")
Set sRng = Rng.Find(Dat, , xlValues, xlWhole)
If sRng Is Nothing Then Cls.Interior.ColorIndex = 38
End If
Next Cls
Rng.NumberFormat = MyFormat
End SubThử code
Sub LinhTinh()
Dim sArr(), Ngay, Ngay0
Dim i&, n&, eRow&, fR&, sR&
Ngay0 = DateValue("2100/1/31")
With Sheets("Sheet2")
sArr = .Range("A1", .Range("A1000000").End(xlUp)).Value
fR = LBound(sArr): sR = UBound(sArr)
End With
Application.ScreenUpdating = False
With Sheets("Sheet1")
eRow = .Range("A1000000").End(xlUp).Row
Do
i = i + 1
Ngay = .Range("A" & i).Value
If Len(Ngay) > 0 Then
ik = i
For n = fR To sR
If sArr(n, 1) < Ngay Then
.Range("A" & i).Resize(3).EntireRow.Insert
.Range("A" & i) = sArr(n, 1)
i = i + 3
ElseIf sArr(n, 1) = Ngay Then
fR = n + 1
Exit For
End If
Next n
If n > sR Then Exit Do
eRow = .Range("A1000000").End(xlUp).Row
If i = eRow Then
eRow = eRow + 1
.Range("A" & eRow) = Ngay0
End If
End If
Loop Until i = eRow
eRow = .Range("A1000000").End(xlUp).Row
If .Range("A" & eRow) = Ngay0 Then Range("A" & eRow).ClearContents
End With
Application.ScreenUpdating = True
End SubXin chào Bác Hiếu,
Xin chào Bác Hiếu,
Con chào Thầy ạ,
Dòng kẻ thì có thể chấp nhận (Merge Cells thì không nên).
