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

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

下面的每个单元格都会返回一个不是date的消息框，即使是空白也是如此。

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个不相邻的列，忽略空白单元格，并且只发现一个消息每一列，如果它发现非date值？

一如既往的感谢

克里斯

Answer 1

我会改变你的循环为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来确定要检查的细胞的范围，但是可以很容易地补偿每列的单个行。

附录：针对显示stream氓非date/非空白单元格的单个消息修改的代码（如下所示）。 Chr(10)只是一个换行符 。

Answer 2

码：

 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