楽天市場のCSVデータから配送指定日を取り出す関数

楽天市場のCSVデータダウンロードを利用して発送伝票を作成しているのですが、配送指定日はコメントフィールドに入っているのですが、これがくせものです。たとえばこんな感じ。

[配送日時指定:]
2007-03-01(木)
午前中
マフラーはラッピングしてください。

時間指定やお客様からのコメントといっしょになっているので、そのまま利用することができません。そこでコメント欄から配送指定日を抽出するユーザー関数を作ってみました。

＊配送指定日はメニューで選択できるようになっているという前提です。また、発送伝票の印刷にはヤマト運輸のB2を利用しています。

Function DeliDate(myRange As Range) As String
'コメント欄に記入された配送指定日を抽出

    Dim myStr() As String
    Dim myStrCnt As Long
    Dim myDate As String
    Dim i As Integer

    'コメント欄の文字列をハイフン区切りで配列に格納
    myStr = Split(myRange.Value, "-")
    'ハイフンで区切った要素の数
    myStrCnt = UBound(myStr)

    'ハイフンが2個以上ない場合(要素数が3に満たない場合)は日付ではない
    If myStrCnt < 2 Then
        DeliDate = ""
    Else
    'ハイフン前後の4,2,2文字のセットが日付として評価できれば、その日付を返す
        For i = 0 To myStrCnt - 2
            myDate = Right(myStr(i), 4) & "/" & _
                                myStr(i + 1) & "/" & _
                                Left(myStr(i + 2), 2)
            If IsDate(myDate) Then
                DeliDate = myDate
            End If
        Next
    End If
End Function

たとえばセルAT2に先のコメントがあるとすると、任意のセルで

=delidate(AT2)

とすることで、

2007/03/01

が取り出せるはずです。