宏以检查列中的非空白单元格以确保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

我想你的循环更改为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 

我使用单个LASTROW从塔AB到确定待检查的细胞的范围，而是为每列各行可以很容易地得到补偿。

附录：针对显示流氓非日期/非空白单元格（如下所示）的单条消息修改的代码。 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