ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2017年11月21日(火) 13:19

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2008年2月18日(月) 00:56 
オフライン

登録日時: 2008年2月17日(日) 18:55
記事: 18
''''' DataValueString6 日付・日付値・日付文字列取得・6桁
Function ZDTEVS6(ZDTV as long) as string
ZDTEVS6="" : If ZDTV<=37986 then Exit Function
Dim ZYAR as long , ZMON as long , ZDAY as long , ZURU as long , ZVAL as long
ZDAY=ZDTV-37986 : ZYAR=Int((ZDAY-1)/1461) : ZDAY=ZDAY-(ZYAR*1461) : ZYAR=ZYAR*4
ZURU=1 : If ZDAY>366 then ZYAR=ZYAR+1 : ZDAY=ZDAY-366 : ZURU=0 : ZVAL=Int((ZDAY-1)/365) : ZYAR=ZYAR+ZVAL : ZDAY=ZDAY-(ZVAL*365)
If ZDAY<=31 then ZMON=1 else ZDAY=ZDAY-31 : If ZDAY<=(28+ZURU) then ZMON=2 else ZDAY=ZDAY-(28+ZURU) : If ZDAY<=31 then ZMON=3 else ZDAY=ZDAY-31 : If ZDAY<=30 then ZMON=4 else ZDAY=ZDAY-30 : If ZDAY<=31 then ZMON=5 else ZDAY=ZDAY-31 : If ZDAY<=30 then ZMON=6 else ZDAY=ZDAY-30 : If ZDAY<=31 then ZMON=7 else ZDAY=ZDAY-31 : If ZDAY<=31 then ZMON=8 else ZDAY=ZDAY-31 : If ZDAY<=30 then ZMON=9 else ZDAY=ZDAY-30 : If ZDAY<=31 then ZMON=10 else ZDAY=ZDAY-31 : If ZDAY<=30 then ZMON=11 else ZDAY=ZDAY-30 : ZMON=12
ZYAR=ZYAR+4 : ZDTEVS6=Str$(ZDAY) : ZDTEVS6=ZSTRRGZ(ZDTEVS6,2) : ZDTEVS6=Str$(ZMON)+ZDTEVS6 : ZDTEVS6=ZSTRRGZ(ZDTEVS6,4) : ZDTEVS6=Str$(ZYAR)+ZDTEVS6 : ZDTEVS6=ZSTRRGZ(ZDTEVS6,6)
End Function

戻値 ZDTEVS6
yymmdd の6桁の文字列。

引数 ZDTV
だいたいのWindowsソフトで共通の日付値です。と思います。エクセルで検証しました。


西暦です。2000年以降の年しか考慮していません。

西暦で
通常は年365日。4で割れる年は366日。100で割れる年は365日。400で割れる年は366日。。。だったと思う。

~Ptrの使い方がイマイチ勉強不足で string型 を使用してます。カンベンして。

と思います。が多くてすいません。だいぶ前に作ったので多少のコメント違いはあるかもしれませんが、コードは現在進行形で使用中ですので間違いは無いと思います。と思います。

''''' StringRightZero 文字列・右・頭0整形
Function ZSTRRGZ(ZSTR as string, ZLEN as long) as string
ZSTRRGZ=String$(ZLEN,"0")+ZSTR : ZSTRRGZ=ZSTRRGT(ZSTRRGZ,ZLEN)
End Function

''''' StringRight 文字列・右
Function ZSTRRGT(ZSTR as string, ZLEN as long) as string
Dim ZLEN as long
ZSTRRGT="" : If ZLEN<1 then Exit Function
ZLEN=Len(ZSTR) : If ZLEN<1 then Exit Function
ZSTRRGT=ZSTR : If ZLEN<=ZLEN then Exit Function
ZSTRRGT=ZeroString(ZLEN) : memcpy(StrPtr(ZSTRRGT),StrPtr(ZSTR)+ZLEN-ZLEN,ZLEN)
End Function


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2008年3月02日(日) 13:27 
オフライン

登録日時: 2006年7月10日(月) 22:57
記事: 4
住所: 埼玉県
興味を持ったのでちょっと検証してみましたが、いくつか問題があります。

1. ZSTRRGT関数で、変数ZLENが引数と関数内変数として定義されている。
  このためコンパイルが通りません(ver4.24)。
2. そもそもZSTRRGT関数の代わりにRight$関数が使える
3. 2100年など100で割り切れ、かつ400で割り切れない年で閏年判定が間違っている。
  例えば、73110を2100年2月29日と判定している。

また、ご本人が書いた通り2000年以降を対象にしているので、定義通り1900年1月1日~9999年12月31日(Excel2002以降?)対応を考えてみました。

[hide]
コード:
’ シリアル値より年月日をyyyymmddの書式で求める
Function _sirial2str(sirial As Long) As String
	Dim sr As Long, year As Long, month As Long, day As Long, fday As Long

	_sirial2str = ""
	If sirial > 0 And sirial <= 2958465 Then
		sr = 1
		' 西暦を求める
		year = 1900
		day = 365
		While sirial > sr + day
			sr = sr + day
			year = year + 1
			If (year Mod 4) = 0 Then
				If (year Mod 100) = 0 Then
					If (year Mod 400) = 0 Then
						day = 366
					Else
						day = 365
					End If
				Else
					day = 366
				End If
			Else
				day = 365
			End If
		Wend
		' 月を求める
		fday = day - 337	' その年の2月の日数
		month = 1
		day = 31
		While sirial > sr + day
			sr = sr + day
			month = month + 1
			Select Case month
				Case 3, 5, 7, 8, 10, 12
					day = 31
				Case 4, 6, 9, 11
					day = 30
				Case 2
					day = fday
			End Select
		Wend
		' 日付を求める
		If year = 1900 And month < 3 Then
			day = sirial - sr + 1	' Excel(と言うよりLotas)のバグのため1900年を閏年としている
		Else
			day = sirial - sr
		End If
		' 文字列に変換
		_sirial2str = Str$(year) ' 6桁表示では、Str$(year Mod 100)
		If month < 10 Then _sirial2str = _sirial2str + "0"
		_sirial2str = _sirial2str + Str$(month)
		If day < 10 Then _sirial2str = _sirial2str + "0"
		_sirial2str = _sirial2str + Str$(day)
	End If
End Function

#N88BASIC
Const sirial = 401827	' 求めたいシリアル値(例は3000/2/28)
Print _sirial2str(sirial)
[/hide]


通報する
ページトップ
投稿記事Posted: 2008年3月05日(水) 21:19 
オフライン

登録日時: 2008年2月17日(日) 18:55
記事: 18
返信ありがとうございます

日付値から日付文字列を取得する
このトピックの本旨を叶えるのは、返信のかたのコードのほうがいいと思います。自作(まっ)は初心者に加え、かすかな記憶をたぐって検証も数年しかしてませんでした。ごめんなさい。
標準で関数が無かった(見つけられなかった)のでプラス1歩で役に立てば、と思った次第です。

プロシージャ ZSTRRGT (StringRight 文字列・右)
元々UPしたかったプロシージャ ZDTEVS6 で使ってたので付け加えたのですが、変数の使い方が汚なかったので整理したら ZLEN が重複してました。ごめんなさい。
Right$関数と同等なので、わざわざの必要は無いんです。なんですが、Right$関数での戻値が、んんん、ありえない???事が何回もあったので、チェックの時間よりも自作のほうがてっとりばやかった。ってな事情です。
コード:
''''' StringRight 文字列・右
Function ZSTRRGT(ZSTR as string, ZLEN as long) as string
ZSTRRGT="" : If ZSTR="" or ZLEN<1 then Exit Function
Dim ZCHK as long : ZCHK=Len(ZSTR) : If ZCHK<=ZLEN then ZSTRRGT=ZSTR : Exit Function
ZSTRRGT=ZeroString(ZLEN) : memcpy(StrPtr(ZSTRRGT),StrPtr(ZSTR)+ZCHK-ZLEN,ZLEN)
End Function


通報する
ページトップ
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 3 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke