宏来检查列中的非空白单元格以确保isdate（）

Question

我一直在寻找一个宏来检查3列，以确保内容是一个日期值。列可以包含空单元格。

下面为每个不是日期的单元格返回一个消息框，即使是空白。

Sub DateCheck()
With ActiveSheet
   lastRow = .Range("AB" & Rows.Count).End(xlUp).Row
   For RowCount = 2 To lastRow
      POC = .Range("AB" & RowCount)
   If Not IsDate(POC) Then
       MsgBox ("Please enter valid date in Cell : AB" & RowCount & ". Example: dd/mm/yyyy")
   End If
  Next RowCount

   End With
End Sub

是否有人可以帮助调整此内容以查看3个不相邻的列，忽略空白单元格，并且只有在找到非日期值时才会为每列返回一条消息？

一如既往地谢谢

克里斯

Answer 1

代码：

Sub DateCheck()
    Dim s(2) As String
    Dim i As Integer
    Dim o As String
    Dim lastRow As Long
    Dim r As Long

    'Enter columns here:
    s(0) = "A"
    s(1) = "B"
    s(2) = "C"


For i = 0 To 2
    With ActiveSheet
        lastRow = .Range(s(i) & Rows.Count).End(xlUp).Row
        For r = 2 To lastRow
            POC = .Range(s(i) & r)

            If Not IsDate(POC) Then
                o = o & ", " & .Range(s(i) & r).Address
            End If
        Next r
        MsgBox ("Please enter valid date in Cells : " & Right(o, Len(o) - 1) & ". Example: dd/mm/yyyy")
        o = ""
   End With
Next i
End Sub

Answer 2

我会将您的循环更改为For Each In ... Next并使用.Union构建一系列不相邻的列。

Sub MultiDateCheck()
    Dim lr As Long, cl As Range, rng As Range, mssg As String
    With ActiveSheet
        lr = .Range("AB" & Rows.Count).End(xlUp).Row
        Set rng = Union(.Range("AB2:AB" & lr), .Range("AM2:AM" & lr), .Range("AZ2:AZ" & lr))
        For Each cl In rng
            If Not IsDate(cl.Value) And Not IsEmpty(cl) Then _
                mssg = mssg & cl.Address(0, 0) & Space(4)
        Next cl
    End With
    If CBool(Len(mssg)) Then
        MsgBox ("Please enter valid date(s) in Cell(s): " & Chr(10) & Chr(10) & _
          mssg & Chr(10) & Chr(10) & _
          "Example: dd/mm/yyyy")
    Else
        MsgBox "All dates completed!"
    End If
    Set rng = Nothing
End Sub

我使用了AB列中的一个 lastrow 来确定要检查的单元格的范围，但每列的各行可以很容易地得到补偿。

附录：针对显示流氓非日期/非空白单元格的单条消息修改了代码（如下所示）。 Chr(10)只是换行字符。