« 道路情報 伊勢湾フェリーが終了・・・残念! | トップページ | 道路情報 152号線走破 ゼロ磁場とは!? »

2010年4月17日 (土)

TIPS : DateDiff を拡張して、経過年月を求める(VBA向け)

VBAなんかで、プログラムをしていると、年齢計算的なロジックが必要になるときがあります。

そんなときに、DateDiffなんかを使おうとするわけですが、この関数、微妙にやりたいことと違うっ

と思うこと、ありますよね。

まあそんなもん、と割り切って使用するというのも手ですが、先人の英知を流用するという手も!

ネットを色々探していたら、こんなユーザ定義関数がありました。

Function fncDateDiff(strType As String, dteStart As Variant, dteEnd As Variant) As Long
'****************************************************************************
'* 機 能 : 経過期間を計算する
'* 説 明 : 変換タイプ
'*         "Y" 年数 / "M" 月数 / "D" 日数
'*         "MD" 1ヶ月未満の日数 / "YM" 1年未満の月数 / "YD" 1年未満の日数
'****************************************************************************
'----------------------------------------------------------------------------
'- 宣言
'----------------------------------------------------------------------------
    Dim lngBuf As Long
    Dim dteBuf As Date
    Dim intYear1 As Integer
    Dim intYear2 As Integer
    Dim intMonth1 As Integer
    Dim intMonth2 As Integer
'----------------------------------------------------------------------------
'- メインルーチン
'----------------------------------------------------------------------------
    If DateDiff("d", dteStart, dteEnd) < 0 _
    Then
        fncDateDiff = -fncDateDiff(strType, dteEnd, dteStart) 
        Exit Function 
    End If

    intYear1 = Year(dteStart)
    intYear2 = Year(dteEnd)
    intMonth1 = Month(dteStart)
    intMonth2 = Month(dteEnd)

    Select Case UCase$(strType)
        '// 年数
        Case "Y"
            lngBuf = Fix(fncDateDiff("M", dteStart, dteEnd) / 12) 
        '// 月数
        Case "M"
            '// 年月を月数に直して概算
            lngBuf = (intYear2 * 12 + intMonth2) - (intYear1 * 12 + intMonth1) 
            '// 開始日からxヵ月後
            dteBuf = DateAdd("m", lngBuf, dteStart)
            If DateDiff("d", dteBuf, dteEnd) < 0 _
            Then 
                lngBuf = lngBuf - 1 
            End If 
        '// 日数
        Case "D"
            lngBuf = DateDiff("d", dteStart, dteEnd) 
        '// 1年未満の月数
        Case "YM"
            lngBuf = fncDateDiff("M", dteStart, dteEnd) Mod 12 
        '// 1ヶ月未満の日数
        Case "MD"
            dteBuf = DateAdd("m", fncDateDiff("M", dteStart, dteEnd), dteStart) 
            lngBuf = DateDiff("d", dteBuf, dteEnd) 
        '// 1年未満の日数
        Case "YD"
            dteBuf = DateAdd("yyyy", fncDateDiff("Y", dteStart, dteEnd), dteStart) 
            lngBuf = DateDiff("d", dteBuf, dteEnd) 
        '// エラーケース
        Case Else
            lngBuf = 0
        End
    End Select

    fncDateDiff = lngBuf

End Function

このオリジナルは、

http://www.niji.or.jp/home/toru/notes/51.html

です。toru2008様、ありがとうございます!!

なお上記コードは、オリジナルと比べて、引数順番と変数記述を変えてあります。

何となくハンガリアン記法を使いたかったのと、引数の順番をDateDiffに合わせたかったから。

そういえば、最近はハンガリアン記法は流行らない、というより、非推奨らしいです。

ハンガリアン記法使用者は、VBやVBAプログラマーには、まだまだ多い気もするけど・・

といっても、VBプログラマーは、減少の一途を辿っているんでしょうね・・・

盛者必衰の理ですね~

ちなみに、盛者必衰の読み方って、「じょうしゃひっすい」が多いらしい。

まあ「せいじゃひっすい」でも間違いじゃないらしいけど。

私は「せいじゃひっすい」派です。

|

« 道路情報 伊勢湾フェリーが終了・・・残念! | トップページ | 道路情報 152号線走破 ゼロ磁場とは!? »

パソコン・インターネット」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)


コメントは記事投稿者が公開するまで表示されません。



トラックバック

この記事のトラックバックURL:
http://app.cocolog-nifty.com/t/trackback/538346/48112762

この記事へのトラックバック一覧です: TIPS : DateDiff を拡張して、経過年月を求める(VBA向け):

« 道路情報 伊勢湾フェリーが終了・・・残念! | トップページ | 道路情報 152号線走破 ゼロ磁場とは!? »