[日付処理] 日付文字列に経過日数を反映させる

  実行結果



  
2002/01/01
1920/12/31
2002/01/01
2020/12/31

2000/01/02
1919/01/01
2000/01/02
2019/01/01

20020101
19201231
20020101
20201231

20000102
19190101
20000102
20190101

01/01/2002
12/31/1920
01/01/2002
12/31/2020

01/02/2000
01/01/1919
01/02/2000
01/01/2019
  



  ソース



  
<HTML><BODY>
<%

Function StrDateAdd( strDate, nDay, nType )

	Dim strWork
	Dim strCheck
	Dim nLen
	Dim dtDate

	' 日付文字列無し
	if strDate = "" then
		StrDateAdd = ""
		Exit Function
	end if

	' 数値エラー
	if not IsNumeric( nDay ) then
		StrDateAdd = ""
		Exit Function
	end if

	' 日付を数値のみにしてチェック
	strWork = Replace( strDate, "/", "" )
	nLen = Len( strWork )
	if nLen <> 6 and nLen <> 8 then
		StrDateAdd = ""
		Exit Function
	end if

	' 6ケタの場合は8ケタに(2000年代とする)
	if nLen = 6 then
		strWork = "20" & strWork
	end if

	' 日付妥当チェック( IsDate は、MM/DD/YYYY )
	strCheck = Mid( strWork, 5, 2 ) & "/" & Right( strWork, 2 ) & "/" & Left( strWork, 4 )
	if not IsDate( strCheck ) then
		StrDateAdd = ""
		Exit Function
	end if

	' 加算の為、フォーマット
	strWork = Left( strWork, 4 ) & "/" & Mid( strWork, 5, 2 ) & "/" & Right( strWork, 2 )

	' 加算
	dtDate = CDate( strWork ) + nDay

	' 日付結果が短い場合、長くする(2000年代とする)
	if Len( dtDate ) = 8 then
		strWork = "20" & dtDate
	else
		strWork = dtDate & ""
	end if

	' タイプ別フォーマット
	Select Case nType
		Case 0
			StrDateAdd = strWork
		Case 1
			StrDateAdd = Replace( strWork, "/", "" )
		Case 2
			StrDateAdd = Mid( strWork, 6, 2 ) & "/" & Right( strWork, 2 ) & "/" & Left( strWork, 4 )
		Case Else
			StrDateAdd = ""
	End Select

End Function

For I = 0 to 2
	Response.Write StrDateAdd( "20010101", 365, I ) & "<br>"
	Response.Write StrDateAdd( "19200101", 365, I ) & "<br>"
	Response.Write StrDateAdd( "010101", 365, I ) & "<br>"
	Response.Write StrDateAdd( "200101", 365, I ) & "<br><br>"
	Response.Write StrDateAdd( "2001/01/01", -365, I ) & "<br>"
	Response.Write StrDateAdd( "1920/01/01", -365, I ) & "<br>"
	Response.Write StrDateAdd( "01/01/01", -365, I ) & "<br>"
	Response.Write StrDateAdd( "20/01/01", -365, I ) & "<br><br>"
Next

%>
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ