宏以檢查列中的非空白單元格以確保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