检查列中的每个单元格的顶部是否有关键字

Question

我创建了一些代码，用于检查每列（行A）顶部的名称DATE。

如果该列包含该列，则代码应遍历该列中的每个单元格，以检查数据格式是否正确。如果代码不正确，则应将单元格的背景色设置为蓝色。

这是我编写的代码，但不确定将其放在哪里或什至可以工作：

Sub dateFromatChecker()

    Dim lrow, lcol As Long

    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Find(What:="date", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Selection.FindNext(After:=ActiveCell).Activate

    ActiveCell.Offset(1, 0).Select
    lrow = Selection.End(xlDown).Row

    For x = 2 To lrow

        If Cells(x, 2).NumberFormat <> "yyyy/dd/mm hh:mm:ss" Then
            'MsgBox "Incorrect Date format, Please use this date yyyy/dd/mm hh:mm:ss"
            Cells(x, 2).Interior.Color = vbBlue
        Else
            'MsgBox "Date is in Proper format"
        End If

    Next x
End Sub

---

这是我想要代码执行的示例：

Answer 1

这可能是一个开始。我决定标记所有格式正确的值，因为我认为这更容易。我在代码中遇到了一些问题，因为我没有将此部分声明为变量

Cells.Find(What:="", After:=CellRange, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate

，因此该宏进入无限循环...但是它使用格式yyyy/dd/mm hh:mm:ss标记所有单元格。您可以点击“ Esc”取消该宏。

所以要玩的东西：

Sub Macro1()
Dim CellRange As Range
Dim lcol As String
Dim lrow As String
Dim ActCellRow As Integer
Dim ActCellCol As Integer
Dim CellVal As String

For i = 1 To 8

CellVal = Cells(1, i)

    If LCase$(CellVal) Like LCase$("*date*") Then
    lrow = Cells(Rows.Count, 3).End(xlUp).Row
        For j = 2 To 9
            Set CellRange = Range(Cells(j - 1, i), Cells(j - 1, i))
                Application.FindFormat.NumberFormat = "yyyy/mm/dd hh:mm:ss"
                Range(Cells(2, i), Cells(lrow, i)).Select
                Cells.Find(What:="", After:=CellRange, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=True).Activate

            ActCellRow = ActiveCell.Row
            ActCellCol = ActiveCell.Column

            Cells(ActCellRow, ActCellCol).Interior.Color = vbBlue

        Next j
    End If
Next i

End Sub

通过ALT + F11打开VBA编辑器。 然后将其粘贴到模块中。