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.4

imogasi

質問の意味の取り方で迷っちゃう。
＞マクロ の日付
この表現もしっくりしない。マクロ で日付・・とでも書けば。
A1,B1には年数字、月数字が入っているのですね。
問題はC列です。
＞20080515・2008年5月15日・2008.05.15・2008.5.15
・2008/05/15・2008/5/15・08/05/15・2008-5-15
は
（１）ほとんど文字列で入っているのか
（２）日付で書式を日付書式で設置しているのか
どちらか質問に書いてない。
ーーー
C列セルの日付と思われる部分を何らかの方法で抜き出し、
A1,B1の年数字、月数字と合成して、日付を作るのですか。
ーーーー
＞20080515・2008年5月15日・2008.05.15・2008.5.15
・2008/05/15・2008/5/15・08/05/15・2008-5-15
の中に
（１）日付シリアル値になっているものがあれば
IsDateとかで切り分け（Date関数で日が取れる）
（２）文字列になっている場合は、セパレータでケース分けし
それセパレータでSplitし、バリアント配列ｄ（2)で日付部分を取り出せば出来ると思う。
ーー
こんな質問のケースは、私たちはそうそう出くわさないので、気を使って質問を書いてほしい。

回答No.3

nda23

以下は参考です。
形式チェック：IsDate関数
http://msdn.microsoft.com/ja-jp/library/00wf8zk9(VS.80).aspx
日付時刻変換：CDate関数
http://msdn.microsoft.com/ja-jp/library/s2dy91zy(VS.80).aspx
※Windows2000　SP3以前の状態で、上記関数を使うと即死する場合があります。

回答No.2

redfox63

VBAのDeteValueは結構、利口なようです
.区切りの文字列と区切り無しの文字列は変換出来ませんが後のパターンは大丈夫なようでした
全角半角混じりでもOKなようです

Function cnvDate(s as String) As Date
　　dim dt as date
　　On Error Resume next
　　' . を / に変更
　　if InStr( s, "." ) then s = Replace(s, ".", "/")
　　dt = DateValue(s)
　　if dt = #12:00:00# then
　　　　' 区切り無しの場合
　　　　' パラメータの桁数チェックなども必要でしょう
　　　　dt = DateValue( format( s, "@@@@/@@/@@" ))
　　end if
　　On Error Goto 0
　　cnvDate = dt
End Function

回答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