Xin nhờ tìm ra định dạng dữ liệu ngày/tháng/năm bị lỗi

[Bùi Thúy Thúy]

Vùng chứa dữ liệu từ cột A đến cột AQ, nhờ các thầy, cô giúp em
cho em xin đoạn code để khi code hoạt động thì
tìm ra định dạng ngày bị lỗi ( định dạng lỗi là ngày 00/01/1900)
Khi tìm ra ô nào đó có định dạng bị lỗi trên thì tô màu nền đen ô đó và chữ màu nền trắng và bôi đậm và gạch ngang (như hình dưới)
(có thể dùng định dạng có điều kiện nhưng bài toán em ứng dụng nếu làm vậy rất lâu)
Xin nhờ sự giúp đỡ của thầy cô!

 

[leonguyenz]

Vùng chứa dữ liệu từ cột A đến cột AQ, nhờ các thầy, cô giúp em
cho em xin đoạn code để khi code hoạt động thì
tìm ra định dạng ngày bị lỗi ( định dạng lỗi là ngày 00/01/1900)
Khi tìm ra ô nào đó có định dạng bị lỗi trên thì tô màu nền đen ô đó và chữ màu nền trắng và bôi đậm và gạch ngang (như hình dưới)
(có thể dùng định dạng có điều kiện nhưng bài toán em ứng dụng nếu làm vậy rất lâu)
Xin nhờ sự giúp đỡ của thầy cô!View attachment 221573

Tô màu nền, font, font đậm, gạch ngang ... làm cho code duyệt trên từng ô rất chậm, cân nhắc việc này nhé.
Tham khảo code:

Sub CheckDate()
Dim Rng As Range, Cel As Range, Lrw As Long
With Sheets("Danh muc NT CVXD")
    Lrw = .Range("E65535").End(xlUp).Row: If Lrw < 10 Then Exit Sub
    Set Rng = Union(.Range("R10:R" & Lrw), .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))
    For Each Cel In Rng
        If Cel <> "" And Cel.Value < 366 Then
            With Cel
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                .Font.Bold = True
                .Font.Strikethrough = True
            End With
        End If
    Next
End With
End Sub

Nếu muốn nhanh hơn chút thì bỏ tô đậm và gạch ngang đi.

 

[HeSanbi]

00/01/1900 chính là định dạng ngày tháng, nếu là số thì nó là số 0, Bạn vào Formatcondition tạo một Quy tắc mới,
"Chỉ định dạng các ô có giá trị" - "Format Only CellsThat Contain", sau đó chọn Equal to ("Bằng") 0, vào Format chọn những màu, kiểu bạn muốn.

 

[Bùi Thúy Thúy]

Tô màu nền, font, font đậm, gạch ngang ... làm cho code duyệt trên từng ô rất chậm, cân nhắc việc này nhé.
Tham khảo code:

Sub CheckDate()
Dim Rng As Range, Cel As Range, Lrw As Long
With Sheets("Danh muc NT CVXD")
    Lrw = .Range("E65535").End(xlUp).Row: If Lrw < 10 Then Exit Sub
    Set Rng = Union(.Range("R10:R" & Lrw), .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))
    For Each Cel In Rng
        If Cel <> "" And Cel.Value < 366 Then
            With Cel
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                .Font.Bold = True
                .Font.Strikethrough = True
            End With
        End If
    Next
End With
End Sub

Nếu muốn nhanh hơn chút thì bỏ tô đậm và gạch ngang đi.

Dạ! cám ơn anh, anh ơi bỏ tô đậm và gạch ngang đi thì bỏ phần nào trong code ạ!

Bài đã được tự động gộp: 23/7/19

00/01/1900 chính là định dạng ngày tháng, nếu là số thì nó là số 0, Bạn vào Formatcondition tạo một Quy tắc mới,
"Chỉ định dạng các ô có giá trị" - "Format Only CellsThat Contain", sau đó chọn Equal to ("Bằng") 0, vào Format chọn những màu, kiểu bạn muốn.

Cám ơn anh đã hướng dẫn.

 

[leonguyenz]

Dạ! cám ơn anh, anh ơi bỏ tô đậm và gạch ngang đi thì bỏ phần nào trong code ạ!

Bài đã được tự động gộp: 23/7/19

Cám ơn anh đã hướng dẫn.

Bỏ 2 dòng tô vàng như hình:

 

[Bùi Thúy Thúy]

Bỏ 2 dòng tô vàng như hình:
View attachment 221580

Thanks anh!

Bài đã được tự động gộp: 23/7/19

Tô màu nền, font, font đậm, gạch ngang ... làm cho code duyệt trên từng ô rất chậm, cân nhắc việc này nhé.
Tham khảo code:

Sub CheckDate()
Dim Rng As Range, Cel As Range, Lrw As Long
With Sheets("Danh muc NT CVXD")
    Lrw = .Range("E65535").End(xlUp).Row: If Lrw < 10 Then Exit Sub
    Set Rng = Union(.Range("R10:R" & Lrw), .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))
    For Each Cel In Rng
        If Cel <> "" And Cel.Value < 366 Then
            With Cel
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                .Font.Bold = True
                .Font.Strikethrough = True
            End With
        End If
    Next
End With
End Sub

Nếu muốn nhanh hơn chút thì bỏ tô đậm và gạch ngang đi.

Em chạy thử code thấy không có tác động, liệu em chạy có bị lỗi thao tác nào không anh?
Anh xem giúp em ạ!

 

[leonguyenz]

File cũ sót cột J, chạy code trong file đính kèm lại thử.

Sub CheckDate()
Dim Rng As Range, Cel As Range, Lrw As Long
With Sheets("Danh muc NT CVXD")
    Lrw = .Range("E65535").End(xlUp).Row: If Lrw < 10 Then Exit Sub
    Set Rng = Union(.Range("J10:J" & Lrw), .Range("R10:R" & Lrw), _
        .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))
    For Each Cel In Rng
        If Cel <> "" And Cel.Value < 366 Then
            With Cel
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                '.Font.Bold = True
                '.Font.Strikethrough = True
            End With
        End If
    Next
End With
End Sub

 

[Bùi Thúy Thúy]

File cũ sót cột J, chạy code trong file đính kèm lại thử.

Sub CheckDate()
Dim Rng As Range, Cel As Range, Lrw As Long
With Sheets("Danh muc NT CVXD")
    Lrw = .Range("E65535").End(xlUp).Row: If Lrw < 10 Then Exit Sub
    Set Rng = Union(.Range("J10:J" & Lrw), .Range("R10:R" & Lrw), _
        .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))
    For Each Cel In Rng
        If Cel <> "" And Cel.Value < 366 Then
            With Cel
                .Interior.ColorIndex = 1
                .Font.ColorIndex = 2
                '.Font.Bold = True
                '.Font.Strikethrough = True
            End With
        End If
    Next
End With
End Sub

Dạ! em điền dữ liệu lỗi và thử lại trên 02 cột và chạy code vẫn chưa thấy bôi đen!
anh xem giúp em ạ!

 

[leonguyenz]

Dạ! em điền dữ liệu lỗi và thử lại trên 02 cột và chạy code vẫn chưa thấy bôi đen!
anh xem giúp em ạ!
View attachment 221589

Bạn sửa đoạn này:

Set Rng = Union(.Range("J10:J" & Lrw), .Range("R10:R" & Lrw), _
        .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))

Nếu cột nào cần duyệt để kiểm tra thì thêm vào, ví dụ cột M: .Range("M10:M" & Lrw)

 

[Bùi Thúy Thúy]

Bạn sửa đoạn này:

Set Rng = Union(.Range("J10:J" & Lrw), .Range("R10:R" & Lrw), _
        .Range("U10:U" & Lrw), .Range("X10:Y" & Lrw))

Nếu cột nào cần duyệt để kiểm tra thì thêm vào, ví dụ cột M: .Range("M10:M" & Lrw)

Vâng, em làm được rồi ạ! cảm ơn anh rất nhiều!