配列に日付を格納してオーバーフローしたお話　の続き

昨日は、2019年6月10日の日付を取得するつもりが、55197年後の日付を求めようとして破綻する結果となった。
infoment.hatenablog.com

最終的には、主たる原因である「セルの書式設定」を一旦標準に戻すことで、解決することが出来た。

ところでその後、コロ子さんから「TEXT関数を用い、シートに一旦仮置きする」というアイディアが提案された（ありがとうございます！）。試してみると、確かにうまくいく。

そこで今日は、ここから派生して、昨日のコードを少し改良してみよう。
f:id:Infoment:20190630115516p:plain

作戦としては、こうだ。

日付と思しき値を、シリアル値で取得する。
シリアル値が８桁の数値である場合、DATESERIAL関数で日付に変換する。
２以外の場合、CDATE関数で日付に変換する。

f:id:Infoment:20190630122301p:plain

.Valueで取得しようとするから、エラーになる。シリアル値で取得すれば（.Value）、書式設定の影響は無いと考えた。

Function ToDate(val As String) As Date
    On Error GoTo er:
    If IsNumeric(CLng(val)) = False Then
        Exit Function
    ElseIf Len(val) = 8 Then
        ToDate = DateSerial(Left(val, 4), _
                            Mid(val, 5, 2), _
                            Right(val, 2))
    Else
        ToDate = CDate(val)
    End If
er:
End Function

早速、テストしてみた。

Sub test()

    Dim TargetRange As Range
    Set TargetRange = Range("A2:A5")
    
    Dim arr As Variant
        ' シリアル値で取得。
        arr = TargetRange.Value2
    
    Dim i As Long
        For i = 1 To UBound(arr)
            arr(i, 1) = ToDate(CStr(arr(i, 1)))
        Next
        
        TargetRange = arr

End Sub