EXCEL VBA マクロ 日付

質問

こんばんわ。
EXCEL VBA マクロ の日付について質問があります。

セル"A1"で"年"（例：2008）、セル"B1"で"月"(例：5)を指定します。
C1からC500くらいまで（毎日増えていきます）日付が入っています。

A1、B1で指定した年月と同じC列の日付を
10桁スラッシュ区切りの形式(例：2008/05/15)で
右隣のセル(D列)にコピーしたいんです。

困ったことにC列は形式が決まっているわけではありません。
たとえば、2008年5月15日の場合、
・20080515・2008年5月15日・2008.05.15・2008.5.15
・2008/05/15・2008/5/15・08/05/15・2008-5-15
その他、いろいろ考えられます。

これをマクロでやるにはどうすればいいでしょうか。

毎月一回実行します。

日付の形式をチェックするところで
やり方がわからなくて困っています。

よろしくお願いします。

回答No.1

fumufumu_2006

こんなのではどうでしょうか？

質問のパターンはクリアしたと思いますが、「その他、いろいろ」に引っかかったら"日付エラー"と表示します。
標準モジュールでsampleを実行してください。
'日付チェック（どうしても変換できない場合は""）
Function dateCheck(str As String) As String
Dim er As Integer
On Error Resume Next
str = DateValue(str)
er = Err.Number
On Error GoTo 0
'エラーなしなら終わり
If er = 0 Then
dateCheck = str
Exit Function
End If
'エラーならいろいろ試す
str = StrConv(str, vbNarrow) '全角文を半角文字に変換
'Dim re As New RegExp
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Pattern = "\D" '数字以外
re.Global = True '全体に
str = re.Replace(str, " ") '数字以外を空白に
Set re = Nothing
str = Trim(str) '余計な空白を削除
str = Replace(str, " ", "/") '空白を/に変換
If (InStr(str, "/") = 0) Then
If (Len(str) = 8) Then '8桁数値(yyyymmdd)を変換
str = Format(str, "@@@@/@@/@@")
ElseIf (Len(str) = 6) Then '6桁数値(yymmdd)を変換
str = Format(str, "@@/@@/@@")
End If
End If

'最後に日付変換してみて、それでもエラーなら""を返す
On Error Resume Next
str = DateValue(str)
er = Err.Number
On Error GoTo 0
If er <> 0 Then
str = "" '
End If
dateCheck = str
End Function

Sub sample()
Dim r As Long
Dim s As String
For r = 1 To Range("C1").End(xlDown).Row
'日付チェック
s = dateCheck(Range("C" & r))
If s = "" Then
'""なら変換できなかった
Range("D" & r) = "日付エラー" '日付としておかしい場合
Else
'年月範囲内か？
If (Year(DateValue(s)) = Range("A1")) And (Month(DateValue(s)) = Range("B1")) Then
'範囲内なら表示
Range("D" & r) = s
Else
'範囲外なら""
Range("D" & r) = ""
End If
End If
Next
End Sub