7本目：日付データの扱い

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：日付データの扱い

#VBA100本ノック 7本目
A列は文字列データ（表示形式が文字列）で日付が入っています。
日付とみなされる場合はB列に月末日付をmmddの形式で出力してください。
日付け以外の場合は空欄にしてください。
例.B2は「0930」と出力する。
※何をもって日付とみなすかも含めて考えてください。

◇ 出題ページはこちら

ソースコード

メインモジュール

Option Explicit

' 100本ノック007：日付データの扱い
Sub 日付文字列を日付に変換する()
    With WS日付リスト
        
        ' データ全行をループ
        Dim R As Long
        For R = 2 To Get最終行(WS日付リスト)
        
            Dim 対象文字列 As String
            対象文字列 = .Cells(R, 1)
        
            ' ストレートに日付に判定できる場合
            If IsDate(対象文字列) Then
                
                .Cells(R, 2) = Format(Fx.EoMonth(CDate(対象文字列), 0), "mmdd")
            
            ' .を/にすると日付になる場合
            ElseIf IsDate(Replace(対象文字列, ".", "/")) Then
            
                .Cells(R, 2) = Format(Fx.EoMonth(CDate(Replace(対象文字列, ".", "/")), 0), "mmdd")
            
            ' 変換できなかった場合
            Else
                .Cells(R, 2) = ""
            End If
        
        Next
    
    End With
End Sub

汎用関数モジュール

Option Explicit

' WorksheetFunctionの短縮取得
' 参考：https://www.limecode.jp/entry/utility/shortcall-worksheetfunction
Function Fx() As WorksheetFunction
    Set Fx = WorksheetFunction
End Function

' 最終行の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終行(指定オブジェクト As Variant, Optional ByVal C As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終行を取得
    Get最終行 = 対象セル範囲.Rows.Count + 対象セル範囲.Row - 1

    ' 列が指定されていればその列の入力最終行を取得
    If C <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(Get最終行, C) = ""
            Get最終行 = Get最終行 - 1
            If Get最終行 < 対象セル範囲.Row Then
                Get最終行 = 0
                Exit Function
            End If
        Loop
    End If

End Function

解説

日付文字列を日付に変換する問題でした。

まずはIsDateがTrueならストレートに変換、
Falseだった時は「.」を「/」に変えて変換しています。

とりあえずメジャーな日付文字列の調整は、
「日本ではありがちな「.」が世界的には日付の区切りではない問題」
だけ対応しておけばいいかなと思います。

もうひとつ注意しなければいけないのが、
IsDateがTrueであってもシート上では日付でないことがあることです。

今回のデータでは「20 10 4」が該当し、
スペース区切りはVBA上では日付ですがExcel上では日付ではありません。

例えばYear("20 10 4")としてみると、
シート上では#VALUEエラーになりますが、
VBA上では2020を取得することが出来ます。

本問題では日付変換後に「月末の日付」にする必要があり、
その変換にはEOMONTH関数が非常に便利です。

しかしEOMONTH関数はワークシート関数ゆえ、
そのまま文字列を渡すとエラーとなってしまいます。

If IsDate(対象文字列) Then ' ← IsDateを突破できても
    .Cells(R, 2) = Fx.EoMonth(対象文字列, 0) ' ← シート関数ではDate扱いできないためエラー

この対策として、VBAの関数であるCDate関数をかませることで、
日付型にしてからEOMONTH関数に渡すことが出来ます。

If IsDate(対象文字列) Then
    .Cells(R, 2) = Fx.EoMonth(CDate(対象文字列), 0) ' ← これでOK

　
WorksheetFunctionを使用する場合は、
VBAとExcelの細かい違いにお気を付けください。