作成者 |
メッセージ |
|
|
返信ありがとうございます
日付値から日付文字列を取得する
このトピックの本旨を叶えるのは、返信のかたのコードのほうがいいと思います。自作(まっ)は初心者に加え、かすかな記憶をたぐって検証も数年しかしてませんでした。ごめんなさい。
標準で関数が無かった(見つけられなかった)のでプラス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
返信ありがとうございます
日付値から日付文字列を取得する このトピックの本旨を叶えるのは、返信のかたのコードのほうがいいと思います。自作(まっ)は初心者に加え、かすかな記憶をたぐって検証も数年しかしてませんでした。ごめんなさい。 標準で関数が無かった(見つけられなかった)のでプラス1歩で役に立てば、と思った次第です。
プロシージャ ZSTRRGT (StringRight 文字列・右) 元々UPしたかったプロシージャ ZDTEVS6 で使ってたので付け加えたのですが、変数の使い方が汚なかったので整理したら ZLEN が重複してました。ごめんなさい。 Right$関数と同等なので、わざわざの必要は無いんです。なんですが、Right$関数での戻値が、んんん、ありえない???事が何回もあったので、チェックの時間よりも自作のほうがてっとりばやかった。ってな事情です。 [code] ''''' 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 [/code]
|
|
|
投稿記事 |
Posted: 2008年3月05日(水) 21:19 |
|
|
|
|
|
興味を持ったのでちょっと検証してみましたが、いくつか問題があります。
1. ZSTRRGT関数で、変数ZLENが引数と関数内変数として定義されている。
このためコンパイルが通りません(ver4.24)。
2. そもそもZSTRRGT関数の代わりにRight$関数が使える
3. 2100年など100で割り切れ、かつ400で割り切れない年で閏年判定が間違っている。
例えば、73110を2100年2月29日と判定している。
また、ご本人が書いた通り2000年以降を対象にしているので、定義通り1900年1月1日~9999年12月31日(Excel2002以降?)対応を考えてみました。
[ここをクリックすると内容が表示されます] [ここをクリックすると非表示にします]コード: ’ シリアル値より年月日を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)
興味を持ったのでちょっと検証してみましたが、いくつか問題があります。
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][code]’ シリアル値より年月日を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)[/code][/hide]
|
|
|
投稿記事 |
Posted: 2008年3月02日(日) 13:27 |
|
|
|
|
|
''''' 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
''''' 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年2月18日(月) 00:56 |
|
|
|
|