SEDを用いて、プレーンテキストや CSVファイルなどを加工したい方、プログラミングに関してヒントの必要な方、ぜひメールを下さい。解決のための何らかのアイデアを提供できると思います…多分。 でも、もしかしたら、ただ一緒に悩むだけかもしれない…
なお、ツールページにも具体例を掲載しています。必要に応じてご参照ください。
悪意を持って作成したスクリプト/プログラムではありませんが、動作内容および動作・使用結果(損害等)に対して、一切の保証や責任を負いません。例え動作させず所有しただけで何らかの損害を被ったとしても(そういう例があるかどうかはともかく)同様に保証・責任を負いません。
SEDを用いた文字列の置換の際、「s/pattern/replacement/g」形式を使っていながら、置換漏れが起こってうまく行かない場合があります。それはreplacementで置換えられる文字列をpatternとして認識しなければならない場合に起こります。命令を実行している間は、一度置換された文字列を無視する仕様だからです(無限ループに陥る危険性を避ける意味があるのでしょう)。その場合は、以下の例のように置換が成功した時点で、新たに置換命令を実行するようにしなければなりません。
:LOOP
s/\("[^",][^",]*\),\([^"]*"\)/\1;\2/
t LOOP
s/\(,"[^",]*","\),/\1;/g
s/\(,[^",]*,"\),/\1;/g
s/^",/";/
※Googleのキャッシュでご覧になる方には上記ソースコードの半角「¥」(=$5C)が、全角のバックスラッシュ「\」に置き換えられて表示されますのでご注意ください。その仕様は酷すぎでしょ?>Google
ある時点から修正されたようです。
s/\([0-9]\)\([0-9][0-9][0-9]\)$/\1,\2/
s/\([0-9]\)\([0-9][0-9][0-9]\)$/\1,\2/
:LOOP1
s/\([0-9]\)\([0-9][0-9][0-9]\)\([^0-9]\)/\1,\2\3/
t LOOP1
:LOOP2
s/\([0-9]\)\([0-9][0-9][0-9]\)\([^0-9]\)/\1,\2\3/
t LOOP2
※Googleのキャッシュでご覧になる方には上記ソースコードの半角「¥」(=$5C)が、全角のバックスラッシュ「\」に置き換えられて表示されますのでご注意ください。その仕様は酷すぎでしょ?>Google
ある時点から修正されたようです。
多重入れ子且つ入れ子数が可変であるループを作りたいとき、以下の方法をお試し下さい。場面によって必要な入れ子数が変化する深いループであっても、容易に作ることができます。千重の入れ子であっても、千個もループを記述する必要がありません。サンプルプログラムは PASCAL で記述してあります。
program VariableNestingLoop (input, output);
var loopbegin, loopend : integer;
var ns : array [1..MAXNESTING] of integer;
begin
for i:=1 to nesting do ns[i] := loopbegin;
repeat
{ .... some looping process are here .... }
{ .... some looping process are here .... }
i := nesting;
ns[i] := ns[i] + 1;
while ( ns[i] > loopend ) and ( i > 0 ) do begin
ns[i] := loopbegin;
i := i - 1;
if i > 0 then
ns[i] := ns[i] +1
end
until i = 0
end.
これは整数値を、Excel/Lotus 1-2-3などのスプレッドシートの桁インデックスに使われている、A,B,…,Z,AA,AB,…,ZZという文字列に変換する関数です。英字だけで構成されるこの「数値」は一見すると27進数のように思えますが、27に対応する「数値」が "A "ではなく"AA"である事から見て違う事は明らかです。そのため27進数ならば728まで表現できますが、この文字列では702までしか表現できません。
以下に示すソースはMS-ExcelのVisual Basic for Applicationで記述したものです。JavaScriptに書き直した例も下に掲載しています。
' 整数値(1〜702)を1桁または2桁までの英字列に変換する関数
' written by Seiji Fujita
' 出力される英字列は、A,B,…,Z,AA,AB,…,ZZ となる。
' 27進数とは異なる点に注意。
Function Num2Alpha(num As Integer) As String
Dim upper As Integer
Dim lower As Integer
Const strRef = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If (num <= 0) Or (num > 702) Then
Num2Alpha = "ERR"
Exit Function
End If
upper = (num - 1) \ 26
lower = (num - 1) Mod 26 + 1
If upper > 0 Then
Num2Alpha = Mid(strRef, upper, 1) + Mid(strRef, lower, 1)
Else
Num2Alpha = Mid(strRef, lower, 1)
End If
End Function
※Googleのキャッシュでご覧になる方には上記ソースコードの半角「¥」(=$5C)が、全角のバックスラッシュ「\」に置き換えられて表示されますのでご注意ください。その仕様は酷すぎでしょ?>Google
ある時点から修正されたようです。
これは(1)とほとんど同じですが、英字にIとOを使わない点が異なっています。英字による番号付けの時に、1とI, 0とOとを混同しない様にするために製造業などで採用される方法です。出力される英字列は、A,B,…,H,J,…N,P,…,Z,AA,AB,…AH,AJ,…,AN,AP,…AZ,…,HZ,JA,…,NZ,PA,…PZ,…,ZZ となります。25進数とは違います。
' 整数値(1〜600)を1桁または2桁までの英字列に変換する関数
' written by Seiji Fujita
' 出力される英字列は、A,B,〜,H,J,〜,N,P,〜Z,AA,AB,〜,AH,AJ,〜,AP,〜,ZZとなる。
' 25進数とは異なる点に注意。
Function Num2Alpha2(num As Integer) As String
Dim upper As Integer
Dim lower As Integer
Const strRef = "ABCDEFGHJKLMNPQRSTUVWXYZ"
If (num <= 0) Or (num > 600) Then
Num2Alpha = "ERR"
Exit Function
End If
upper = (num - 1) \ 24
lower = (num - 1) Mod 24 + 1
If upper > 0 Then
Num2Alpha = Mid(strRef, upper, 1) + Mid(strRef, lower, 1)
Else
Num2Alpha = Mid(strRef, lower, 1)
End If
End Function
※Googleのキャッシュでご覧になる方には上記ソースコードの半角「¥」(=$5C)が、全角のバックスラッシュ「\」に置き換えられて表示されますのでご注意ください。その仕様は酷すぎでしょ?>Google
ある時点から修正されたようです。
Split関数のないExcel 97のVBAで使えます(もちろんExcel 2003のVBAでも使えますし、WordなどのVBAでも使えます)。strSplit() は、文字列 src を文字列 sep で区切り、pos 番目の切り取り文字列を返します。sepの取りうる値は、文字列srcがN個に分割された場合、0〜N-1の範囲となります。区切り文字 sep が文字列 src 中に存在しなかった場合や、文字列の分割数N以上の pos が指定された場合の戻り値は""(空文字)になります。
直ぐ下にあるJavaScript版 "1. (1) function for splitting strings"も参照して下さい。
空白文字で区切りたい場合に連続した空白で上手く切り出せない場合は、xtrim関数を利用すると良いでしょう。
' VBA 2000以降のSplitが使えない場合用の文字列分割関数
' posが切り出しの要素を指定する数値で、1番目の要素番号は0
' 分割数以上の要素を指定した場合の戻り値は空文字""
' 切り出し文字 sep が srcに含まれていない場合の戻り値は空文字""
' written by Seiji Fujita
' 区切り文字が空文字だった場合に対処した
Function strSplit(ByVal src As String, ByVal sep As String, ByVal pos As Long) As String
Dim prePtr As Long
Dim postPtr As Long
Dim strWord As String
Dim i As Long
Dim flag As Boolean
If sep <> "" Then
i = 0
flag = False
Do While prePtr <= Len(src) And i <= pos
If prePtr <= 0 Then
postPtr = InStr(src, sep)
prePtr = 1
Else
postPtr = InStr(prePtr, src, sep)
End If
If postPtr >= 1 Then
strWord = Mid(src, prePtr, postPtr - prePtr)
prePtr = postPtr + Len(sep)
Else
If i > 0 And flag = False Then
strWord = Mid(src, prePtr)
Else
strWord = ""
End If
flag = True
End If
i = i + 1
Loop
If i <= pos Then
strWord = ""
End If
strSplit = strWord
Else
strSplit = ""
End If
End Function
Split関数のないExcel 97のVBAで使えます(もちろんExcel 2003のVBAでも使えますし、WordなどのVBAでも使えます)。
関数は、単語の分割数(0以上)を戻り値とします。戻り値が0の時は、区切り文字が存在せず分割できなかった事を示し、SplitWord(0)〜SplitWord(NUM-1) は空文字 "" となります。
[注] 戻り値が0の時に、SplitWord(0) に src が代入される方が良い場合には、オプションパラメータnotfoundにTrueを与えて呼び出して下さい。
戻り値が-1だった場合には、単語の分割数が設定した配列の格納数より多いこと(つまり単語の分割数 > NUM + 1; 設定した配列の上限値が小さすぎたこと)を示し、SplitWord(0)〜SplitWord(NUM-1) には正しく分割した文字列が入りますが、本来切り出されるべき NUM+1 番目以降の文字列は取得できません。
直ぐ下にあるJavaScript版 "1. (2) function for splitting strings; using global array" も参照して下さい。
' VBA 2000以降のSplitが使えない場合用の文字列分割関数 ; 配列使用版
' posが切り出しの要素を指定する数値で、1番目の要素番号は0
' 分割数以上の要素を指定した場合の戻り値は空文字""
' 切り出し文字 sep がない場合や sep が空文字の場合の戻り値は空文字""
' written by Seiji Fujita
'
' 関数は、単語の分割数(0以上)を戻り値とします。戻り値が0の時は、区切り
' 文字が存在せず分割できなかった事を示し、SplitWord(0)〜SplitWord(NUM-1) は
' 空文字 "" となります。 notfound = False または 無指定の場合。
'
' 戻り値が0の時(=区切り文字が存在せず分割できなかった時)に、
' SplitWord(0) に src が代入される方が良い場合には、
' オプショナルパラメータ notfound を True にして下さい。
'
' 戻り値が-1だった場合には、単語の分割数が設定した配列の格納数より多いこと
' (つまり単語の分割数 > NUM + 1; 設定した配列の上限値が小さすぎたこと)を
' 示し、SplitWord(0)〜SplitWord(NUM-1) には正しく分割した文字列が入りますが、
' 本来切り出されるべき NUM+1 番目以降の文字列は取得できません。
'
' NUMは大域定数として宣言して下さい
' 本関数を呼び出す側でSplitWord()に相当する配列を用意して下さい。
Function strSplitG(ByVal src As String, ByVal sep As String, _
ByRef SplitWord() As String, Optional notfound As Boolean) As Integer
Dim prePtr As Long
Dim postPtr As Long
Dim strWord As String
Dim i As Long
Dim flag As Boolean
Erase SplitWord
If sep <> "" Then
i = 0
flag = False
Do While prePtr <= Len(src) And flag = False And i <= NUM
If prePtr <= 0 Then
postPtr = InStr(src, sep)
prePtr = 1
Else
postPtr = InStr(prePtr, src, sep)
End If
If postPtr >= 1 Then
SplitWord(i) = Mid(src, prePtr, postPtr - prePtr)
prePtr = postPtr + Len(sep)
Else
If i > 0 And flag = False Then
SplitWord(i) = Mid(src, prePtr)
prePtr = Len(src) + 1
End If
flag = True
End If
i = i + 1
Loop
If InStr(prePtr, src, sep) > 0 And i > NUM Then '----(A)
strSplitG = -1
Else
If i = 1 Then ' And SplitWord(0) = ""
strSplitG = 0
If notfound = True Then
SplitWord(0) = src
End If
Else
strSplitG = i
End If
End If
Else
strSplitG = 0
If notfound = True Then
SplitWord(0) = src
End If
End If
End Function
※(A)で記したIf文の判定は
If Len(Mid(src, prePtr)) > 0 And i > NUM Then
と書くことも可能(論理は同じ)
■利用サンプル
Public Const NUM As Integer = 20
Sub Sample()
Dim SplitWord(NUM) As String
Dim i As Integer
Dim n As Integer
Dim str As String
n = strSplitG("abcdefg", "c", SplitWord())
MsgBox "分割数は:" & n
str = "分割状況は:"
For i = 0 To n - 1 ' あるいは For i = 0 To NUM
str = str & CStr(i) & "=" & SplitWord(i) & " / "
Next i
MsgBox str
End Sub
※ちなみに、Excel 97のVBAでExcel 2000などと同等のsplit関数が欲しい場合は、
SPLIT-funktion for Excel 97
のページを参考にするとよいでしょう。
また別案としてVBAからVBSのSplitを呼び出す裏技「Excel97VBAでSplit関数を使う方法」もあります。なるほどぉ!と思いましたが、呼び出す際に文字列扱い且つEval処理しなくてはいけないのが若干読みにくいかも。それにVBSのバージョンによらずSplitが常に含まれているのだろうか?とか、VBSが常に使える環境かどうかの確認ができない場合にはどうするんだろう?とか気になるといえば気になりますが…。 そういう自分自身もVBAで困難な低レベル処理をVBSやCOMを呼び出したりして実装する場合もありますから(でもそれらが確実に呼べると分かっている環境でしか使いませんが)、アイデアとしては面白いと思います。
例えばMS Excelのワークシート関数 DATEDIFでは正しく満年齢を求める事が可能(※注)なのに対して、VBAの類似関数Datediffでは同じような指定をしても正しい満年齢が求まりません([2004-06-24] MS Excel 97のVBA関数のバグを参照のこと)。
※[2023-02-12補足] ワークシート関数 DATEDIFも、閏年の2月29日生まれに対する平年の2月28日時点の年齢が間違った値となる(1少ない値となる)ことが判明(Excel 97, Excel 2003, Excel 2010およびOffice 365 Excel Onlineにて確認)。
極端な例として2006年12月31日生まれの人の1日後の2007年1月1日時点での年齢を求めようとしてDatediff("yyyy","2006/12/31", "2007/01/01")を計算させると、結果は0ではなく1が返ります。これはオンラインヘルプにも書かれているとおり「仕様」です(納得はいきませんし、普通に考えればバグです)。そのため、VBAで満年齢を正しく求めるには若干の工夫が必要です。(この変な「仕様」はExcel 97〜Excel 2003でずっと引き継がれています;多分Excel 95も同様だと思います)
CalcAge()関数に、引数として生年月日 daybirthを yyyy/mm/dd形式(mm, ddは1桁でも可能)、年齢を決定する時点の日付 fixdayを yyyy/mm/dd形式(mm, ddは1桁でも可能)で与えると、満年齢が整数値で返ります。daybirthおよびfixdayは基本的には1バイトコード(半角文字)の文字列で指定すべきですが、全角文字が混在していても関数内で強制的に1バイトコードに置換し直すのでエラーにはなりません。VBA側で呼び出す場合、fixdayには例えばDate関数やNow()関数、CDate()関数などで日付を与えても構いません(文字列に自動変換されるため)。
ワークシート上で =CalcAge(A1,B1) 風に利用する場合、パラメータ部に日付関連関数を直接書き込む場合はは文字列に自動変換されないため、TEXT(NOW(),"YYYY/MM/DD")やTEXT(TODAY(),"YYYY/MM/DD")の様に記述する必要があります。書式は"YYYY/M/D"でも問題ありません;例:=CalcAge("2000/1/3",TODAY()) ではなく =CalcAge("2000/1/3",TEXT(TODAY(),"YYYY/MM/DD")) とする。なお日付関連関数が代入されたセルを指定する場合には特別な書式指定は不要です。;例:D10セルに=TODAY()が代入されている場合に =CalcAge("2000/1/3",D10)と記述できます。
→ daybirth, fixdayの型宣言をStringではなくDateとすることでこの問題は解消。
IsLeapYear()関数は、「指定した日が祝日か否かを調べる関数」内に記述してある関数を使用のこと
' VBAのDateDiffでの年齢計算は、そのままでは使い物にならないので、
' 正しく満年齢を計算できるように補正する関数
' 指定された日付の時点での満年齢を求める
' 日付 daybirth, fixday は yyyy/mm/dd (mm, ddは1桁も許容) 形式の文字列である事
' 正常な戻り値は 0以上の整数(0と正の整数)
' 異常な場合の戻り値は 負の整数
' 日付パラメータが日付形式でない:-1
' daybirth > fixday(計算日が誕生日より過去): -2
' msgflagにTrue指定した場合に戻り値が負ならば、メッセージボックスを表示する
' written by Seiji Fujita
' revised by Seiji Fujita on February 12, 2023
' revised by Seiji Fujita on October 15, 2024
Function CalcAge(ByVal daybirth As Date, ByVal fixday As Date, _
Optional ByVal msgflag As Boolean) As Integer
Dim bmd As Integer
Dim fmd As Integer
'全角数字が混じっていても実際にはエラーにならないが念を入れて変換しておく
daybirth = StrConv(daybirth, vbNarrow)
fixday = StrConv(fixday, vbNarrow)
If (IsDate(daybirth) And IsDate(fixday)) = False Then
If msgflag = True Then
MsgBox "日付パラメータが適切な値ではありません。", vbCritical
End If
CalcAge = -1
Exit Function
End If
If daybirth > fixday Then
If msgflag = True Then
MsgBox "計算日が誕生日より過去です(日付パラメータが逆です)", vbCritical
End If
CalcAge = -2
Exit Function
End If
bmd = 100 * Month(daybirth) + Day(daybirth)
fmd = 100 * Month(fixday) + Day(fixday)
CalcAge = DateDiff("yyyy", daybirth, fixday)
If CalcAge > 0 And fmd < bmd Then
If IsLeapYear(Year(daybirth)) And bmd = 229 Then
If Not (Not (IsLeapYear(Year(fixday))) And fmd = 228) Then
CalcAge = CalcAge - 1
End If
Else
CalcAge = CalcAge - 1
End If
End If
End Function
Sub Sample()
MsgBox CalcAge("2006/12/31", "2007/01/01") ' result = 0
MsgBox CalcAge("2006/12/31", CDate("February 2, 2017")) ' result = 10
MsgBox CalcAge("2006/12/31", CDate("2008-10-10")) ' result = 1
MsgBox CalcAge("1964/2/29", CDate("2007-02-28")) ' result = 43
MsgBox CalcAge("1964/2/29", CDate("2008-02-28")) ' result = 43
MsgBox CalcAge("1964/2/29", CDate("2008-02-29")) ' result = 44
MsgBox CalcAge("1980/10/10", "2005/06/02") ' result = 24
MsgBox CalcAge("1980/10/10", Now()) '
MsgBox CalcAge("1980/10/10", Date)
End Sub
※ワークシート上で利用する場合、TODAY(), NOW()は以下のように書式変換して与える必要があります。 =CalcAge("1980/10/10", TEXT(NOW(),"YYYY/MM/DD")) =CalcAge(A1, TEXT(TODAY(),"YYYY/M/D"))→ daybirth, fixdayの型宣言をStringではなくDateとすることでこの問題は解消
※DateDiffを使用しないなら、以下の記述CalcAge2となります。使用方法は、上記CalcAge関数に準じます。
' VBAのDateDiffでの年齢計算は、そのままでは使い物にならないので、
' 正しく満年齢を計算できるように補正する関数 単純計算版(DateDiff不要版)
' 指定された日付の時点での満年齢を求める
' 日付 daybirth, fixday は yyyy/mm/dd (mm, ddは1桁も許容) 形式の文字列である事
' 正常な戻り値は 0以上の整数(0と正の整数)
' 異常な場合の戻り値は 負の整数
' 日付パラメータが日付形式でない:-1
' daybirth > fixday(計算日が誕生日より過去): -2
' msgflagにTrue指定した場合に戻り値が負ならば、メッセージボックスを表示する
' written by Seiji Fujita
' revised by Seiji Fujita on February 12, 2023
' revised by Seiji Fujita on October 15, 2024
Function CalcAge2(ByVal daybirth As Date, ByVal fixday As Date, _
Optional ByVal msgflag As Boolean) As Integer
Dim bmd As Long
Dim fmd As Long
Dim bymd As Long
Dim fymd As Long
'2バイト数字が代入された場合を考慮して1バイト変換しておく
daybirth = StrConv(daybirth, vbNarrow)
fixday = StrConv(fixday, vbNarrow)
If (IsDate(daybirth) And IsDate(fixday)) = False Then
If msgflag = True Then
MsgBox "日付パラメータが適切な値ではありません。", vbCritical
End If
CalcAge2 = -1
Exit Function
End If
bmd = 100 * Month(daybirth) + Day(daybirth)
fmd = 100 * Month(fixday) + Day(fixday)
bymd = 10000 * Year(daybirth) + bmd
fymd = 10000 * Year(fixday) + fmd
If IsLeapYear(Year(daybirth)) And bmd = 229 Then
If Not (IsLeapYear(Year(fixday))) And fmd = 228 Then
bymd = bymd - 1
End If
End If
CalcAge2 = Int((fymd - bymd) / 10000)
If CalcAge2 < 0 Then
If msgflag = True Then
MsgBox "計算日が誕生日より過去です(日付パラメータが逆です)", vbCritical
End If
CalcAge2 = -2
End If
End Function
*MS Excelのワークシート関数DATEDIFを用いればもっと簡単になりますが、残念ながら閏年の2月29日生まれに対する平年の2月28日時点の年齢が間違った値となる(1少ない値となる)ことが判明したので、うまくいきません。
注:DATEDIFのバグに関して、終了日に+1すれば補正できるとの指南をするWebサイトもありますが、実際にはより悲惨な間違いを生むので意味がありません。補正しない場合は、閏年の2月29日生まれに対して閏年の2月28日の年齢だけを間違うのに対して、+1補正すると平年&閏年問わず2月29日以外の任意日に生まれた場合の誕生日前日の年齢を+1だけ大きく間違える結果となります(つまり2月29日生まれだけ4年に1回だけ間違うものを365日どの日生まれに対しても毎年1回間違うようにするだけの改悪です。例:1999年1月25日生まれの2005年1月24日時点の年齢は5歳が正解ですが+1補正の結果は6歳となってしまいます)。
' Excel ワークシート関数 DATEDIFを使用する関数;閏年生まれにエラーが発生する!
Function CalcAgeWithDatedif(ByVal daybirth As String, ByVal fixday As String) As Integer
Dim strdf As String
strdf = "DATEDIF(" & """" & bd & """" & "" & "," & """" & fd & """" & "," & """Y""" & ")"
CalcAgeWithDatedif = Application.Evaluate(strdf)
End Function
に対して、
MsgBox CalcAgeWithDatedif("1964/2/29", "1967/2/28") ' returns 2 instead of 3
とすれば3が返ってくれるハズですが、残念ながら誤った2が返ります。
※CalcAgeもCalcAge2も、一般的な解釈での満年齢(もしくは法律上の満年齢)を求める式です。なぜかは不明ながら、お役所では満年齢を判定する日付が生誕日の前日であることが多いらしいので(具体的には2000年3月3日生まれの人は、2003年3月2日に3歳に達したと見なす)、そのような用途の場合は注意して下さい。
是正すべきではないかとの答弁もあり→ 年齢の計算に関する質問主意書 (衆議院 質問答弁情報 第154回国会; 2002-07-25)
※ Wikipediaによれば、満年齢の定義に問題がある様子。誕生日を迎える前日の午後12時(即ち、誕生日の午前0時)をもって1歳を加算するのですが、「各法令における年齢制限規定について、日を単位とする場合は時刻の部分(午後12時)を切り捨てるため、その効力は3月31日の初め(午前0時)から発生している」という理屈で年齢制限などは誕生日の前日が含まれるらしい。その一方で『法令によっては「×歳に達した日の翌日」という規定がある』場合は普通に誕生日を指すことになります。また「単位を見分けるときは、「×歳に達した日」など「日」という文言が用いられている場合は日単位、「×歳以上」「×歳に満たない者」など「日」という文言が用いられていない場合は時刻単位と解するのが一般的である。」というように日を強調した文面かそうでないかで解釈が異なるというのも混乱を招くように思えます。
なお、年齢計算ニ関スル法律によれば「2月29日生まれの者の年齢は、平・閏年を問わず、2月28日の終了時に1歳を加える。」という事で平年は29日がないので例外処理、閏年はその他の日生まれと同じ考えということ。
年齢計算ニ関スル法律によれば2月29日生まれの者の年齢は、平年は29日がないので例外処理として28日を迎えた時点で歳を加算、閏年は29日を迎えた時点で歳を加算。
過去に参照した時点のWikipediaの内容「平・閏年を問わず、2月28日の終了時に1歳を加える。」が間違っていたことが判明。且つそれに対する「という事で平年は29日がないので例外処理、閏年はその他の日生まれと同じ考えということ。」の記述が結果として正しいが参照元と矛盾した論理であることから訂正。@2023-02-12
繰り返しになりますが、上に示したCalcAgeとCalcAge2はWikipediaの情報によるところの「時刻単位」で解釈した場合の満年齢が求まるアルゴリズムになっています(2月29日生まれの場合も問題ありません)。
※2023年2月12日以前のコードでは閏年の2月29日生まれで平年の2月28日時点の年齢が正しくなかったため修正した。
(1) 使い方は、直ぐ下にあるJavaScript版 5.(4)を参照してください。なおVBAの場合は標準でtrim関数があるので、JavaScript版の様に別途trim関数、ltrim関数、rtrim関数を用意する必要はありません。
使用場面はいろいろ考えられますが、例えば空白で区切られた文字列をSplit関数(や本ページで記すstrSplit関数)で切り出す際に、連続した空白が混入していて意図した区切りができない場合の前処理として、Split(xtrim(srcstring)," ")風に利用すると便利でしょう。
' 文字列の両側の空白を除去し、文字列内の連続した空白を1つに縮める関数
' written by Seiji Fujita
Function xtrim(ByVal s As String) As String
Dim p As Integer
Dim tmp As String
s = Trim(s)
p = 1
Do While p < Len(s)
If Mid(s, p, 1) = " " Then
s = Left(s, p - 1) & " " & Mid(s, p + 1)
End If
If Mid(s, p, 1) = " " And (Mid(s, p + 1, 1) = " " Or Mid(s, p + 1, 1) = " ") Then
s = Left(s, p - 1) & " " & Mid(s, p + 2)
Else
p = p + 1
End If
Loop
xtrim = s
End Function
(2) 上記はExcel 97など古い版からExcel 2003以降でも動きます。Excel2000以降で追加されたReplace関数が使える場合には以下の記述も可能です。
※Excel 97で利用したい場合には、Excel 97用の代用関数 strReplace を定義した上で、以下のコード内の Replace 部分を、strReplace と書き換えて下さい。
' 文字列の両側の空白を除去し、文字列内の連続した空白を1つに縮める関数 (Replace関数使用版)
' written by Seiji Fujita
Function xtrim(ByVal s As String) As String
Dim p As Integer
Dim tmp As String
s = Trim(s)
s = Replace(s, " ", " ")
p = 1
Do While p < Len(s)
If Mid(s, p, 1) = " " Then
s = Left(s, p - 1) & " " & Trim(Mid(s, p + 1))
End If
p = p + 1
Loop
xtrim = s
End Function
(3) ExcelのVBAだけでしか使えませんが、最も簡単な方法です。但し、これはWordやAccessのVBAでは使えない方法なので注意して下さい。
' 文字列の両側の空白を除去し、文字列内の連続した空白を1つに縮める関数
' (ワークシート関数のTRIM使用版)
' ExcelのVBAでしか通用しない事に注意
Function xtrim(ByVal s As String) As String
Application.Trim(s)
End Function
オリジナルは、「DEKOのアヤシいお部屋。」の「指定した日が祝日かどうかを調べる」(および、Delphi で "指定した日が祝日かどうか" を調べるで紹介されている、Delphiでコーディングされた1948年〜2007年(これ以後は休日法が改定されるまでは有効)の祝祭日・休日を求める関数です。祝日名も取得できます。移植&公開を快諾いただいています(多謝)。
[2008-04-24] 2007年1月1日の祝日法の改正(第三条第二項) 「国民の祝日」が日曜日に当たるときは、その日後においてその日に最も近い「国民の祝日」でない日を休日とする。 (振替日が祝祭日と重なる場合、祝祭日の明けた最初の平日が振替休日となるという意味です)に対応させました。
例:2008年5月6日や2009年5月6日はそれぞれ、振替の振替、振替の振替の振替の結果、休日になります。
移植時点では法改正に気付いておらず、本日対応しました(修正無しでも2008年5月直前までは結果に相違はありません)。
コード変更はDEKO氏とは別に対処した結果、オリジナル・コードとの相違が生じています。但し、国民の休日処理に関しては、DEKO氏が改善したコードに倣い、5月と9月で処理していたのを休日法の定義に立ち返って一本化しました。私のコードの2007年以降の振替休日判定を、DEKO氏のコードに沿ってVBAで記述するならば、IsSpecialHolidayの一番最後のElse If節を以下で置き換えて下さい(その場合、IsSubstituteHoliday は不要になります)。
併せて、IsSpecialHolidayの宣言部に、「Dim i As Integer」を追加して下さい。
[2018-12-25] 本質的に同じなのでDEKO氏のコードに揃えることにしました。
[2016-03-12] 2016年8月11日の山の日を追加
[2018-12-25〜2018-12-28 訂正] 皇室典範特例法(2019/12/23, 2020/2/20)、2019年5月1日の天皇即位の日、2019年10月22日の即位礼正殿の儀の行われる日、五輪祝日移動法、および体育の日の改名に対応
[2019-09-11 訂正] コードの不備で2020年8月11日も山の日と表示されてしまう不具合を修正
[2021-01-17] 2020年7月24日がスポーツの日と判定されない不具合を修正。且つ、2021年の再度の五輪祝日移動法に対応
パラメータ ADate には日付型変数か定数または文字列(例:DateValue("2007/10/15") や "2007/10/15")を設定し、文字列型パラメータ Aname には求めた結果の祝日名が返ります(つまり呼び出し側で Aname 用に与えた変数内容は破壊されます)ので、それを考慮した変数を事前に用意して下さい。また、関数の戻り値はブール型定数(祝祭日・休日であれば True、そうでないなら False)です。
※春分の日・秋分の日は「厳密には」総理府の発表で決定することになりますが、多くの場合は、計算で求まるので修正が必要な例は稀だと思います。
' http://homepage1.nifty.com/ht_deko/tech004.html を参考にしてVBAに移植
' Translated into VBA by Seiji Fujita on October 31, 2007
' Revised judge process for substitute holiday by Seiji Fujita on April 24, 2008
' http://koyomi.vis.ne.jp/
' http://www.asahi-net.or.jp/~CI5M-NMR/misc/equinox.html#Rule
' ------------------------------------------------------------
' ADateが祝日かどうかを返す。
' 祝日=True,祝日ではない=False
' AName には祝日の名前を返す
Function IsSpecialHoliday(ByVal Adate As Date, ByRef Aname As String) As Boolean
Dim dYear As Integer
Dim dMonth As Integer
Dim dDay As Integer
Dim DName As String
Dim i As Integer
IsSpecialHoliday = False
Aname = ""
If MainIsSpecialHoliday(Adate, DName) Then
IsSpecialHoliday = True
Aname = DName
ElseIf Adate >= DateValue("1973/4/12") And Adate < DateValue("2007/1/1") _
And Weekday(Adate, vbSunday) = vbMonday And MainIsSpecialHoliday(Adate - 1, DName) Then
' 振替休日 1973/04/12〜2007/01/01
' 日曜日と祝祭日が重なった場合には“振替休日”となる
' ※2007/1/1より前という条件を外しても結果は同じですが、敢えて残してあります
IsSpecialHoliday = True
Aname = "振替休日"
ElseIf Adate >= DateValue("1988/5/4") And Weekday(Adate, vbSunday) <> vbSunday _
And MainIsSpecialHoliday(Adate - 1, DName) And MainIsSpecialHoliday(Adate + 1, DName) Then
' 国民の休日 1988/05/04以降 (1985/12/27 施行)
' 祝日と祝日に挟まれた平日は“国民の休日”となる。
IsSpecialHoliday = True
Aname = "国民の休日"
ElseIf Adate >= DateValue("2008/5/6") And Weekday(Adate, vbSunday) <> vbSunday _
And MainIsSpecialHoliday(Adate - Weekday(Adate, vbSunday) + 1, DName) Then
' 振替休日(2) 2008/05/06以降 (2007/1/1 施行)
' “祝日”が日曜日に当たるときは、その日後においてその日に最も近い“祝日”でない日を休日とする
IsSpecialHoliday = True
Aname = "振替休日"
For i = 1 To Weekday(Adate, vbSunday) - 2
If Not MainIsSpecialHoliday(Adate - i, DName) Then
IsSpecialHoliday = False
Aname = ""
End If
Next i
End If
End Function
' AYear年AMonth月の第AWeekNo「ADayOfWeeek曜日」の日付を返す
' ADayOfWeeek 日曜日=1..土曜日=7
Private Function FreqOfWeek(ByVal AYear As String, ByVal AMonth As String, _
ByVal AWeekNo As Integer, ByVal ADayOfWeeek As Integer) As Date
Dim dDay As String
Dim dDoW As Integer
Dim dWeekNo As Integer
dDoW = Weekday(AYear & "/" & AMonth & "/1", vbSunday)
dWeekNo = AWeekNo
If ADayOfWeeek >= dDoW Then
dWeekNo = dWeekNo - 1
End If
dDay = (dWeekNo * 7) + (ADayOfWeeek - dDoW) + 1
FreqOfWeek = DateValue(AYear & "/" & AMonth & "/" & dDay)
End Function
' SYearからEYear迄に何回閏年があるかを返す
Private Function LeapYearCount(ByVal SYear As Integer, ByVal EYear As Integer) As Integer
Dim i As Integer
Dim Cnt As Integer
Cnt = 0
For i = SYear To EYear
If IsLeapYear(i) Then
Cnt = Cnt + 1
End If
Next i
LeapYearCount = Cnt
End Function
' Ayearの春分の日を求める
Private Function VernalEquinox(ByVal AYear As Integer) As Date
Dim dDay As Integer
dDay = Int((21.147 + ((AYear - 1940) * 0.2421904) - (LeapYearCount(1940, AYear) - 1)))
VernalEquinox = DateValue(AYear & "/3/" & dDay)
End Function
' Ayearの秋分の日を求める
Private Function AutumnalEquinox(ByVal AYear As Integer) As Date
Dim dDay As Integer
dDay = Int((23.5412 + ((AYear - 1940) * 0.2421904) - (LeapYearCount(1940, AYear) - 1)))
AutumnalEquinox = DateValue(AYear & "/9/" & dDay)
End Function
' MainIsSpecialHoliday
' ADateが祝日かどうかを返す。
' 祝日=True,祝日ではない=False
' AName には祝日の名前を返す
' “国民の休日”はここでは算出されない
Private Function MainIsSpecialHoliday(ByVal Adate As Date, ByRef Aname As String) As Boolean
Dim dYear As Integer
Dim dMonth As Integer
Dim dDay As Integer
Aname = ""
MainIsSpecialHoliday = False
Call DecodeDate(Adate, dYear, dMonth, dDay)
Select Case dMonth
Case 1
' “元日” 1948〜
If (dYear >= 1948) And (dDay = 1) Then
MainIsSpecialHoliday = True
Aname = "元日"
Exit Function
End If
' “成人の日(1)” 1948〜1999
If (dYear >= 1948) And (dYear <= 1999) And (dDay = 15) Then
MainIsSpecialHoliday = True
Aname = "成人の日"
Exit Function
End If
' “成人の日(2)” 2000〜
' 第2月曜日(ハッピーマンデー)
If (dYear >= 2000) Then
If Adate = FreqOfWeek(dYear, dMonth, 2, 2) Then
MainIsSpecialHoliday = True
Aname = "成人の日"
Exit Function
End If
End If
Case 2
' “建国記念の日” 1966〜
If (dYear >= 1966) And (dDay = 11) Then
MainIsSpecialHoliday = True
Aname = "建国記念の日"
Exit Function
End If
' 天皇誕生日A' 2020〜
If (dYear >= 2020) And (dDay = 23) Then
MainIsSpecialHoliday = True
Aname = "天皇誕生日"
Exit Function
End If
' ※昭和天皇の大喪の礼(1989/02/24)
If (dYear = 1989) And (dDay = 24) Then
MainIsSpecialHoliday = True
Aname = "昭和天皇の大喪の礼"
Exit Function
End If
Case 3
' “春分の日” 1949〜
If (dYear >= 1949) Then
If Adate = VernalEquinox(dYear) Then
MainIsSpecialHoliday = True
Aname = "春分の日"
Exit Function
End If
End If
Case 4
' “天皇誕生日” 1948〜1988
If (dYear >= 1948) And (dYear <= 1988) And (dDay = 29) Then
MainIsSpecialHoliday = True
Aname = "天皇誕生日"
Exit Function
End If
' “みどりの日(1)” 1989〜2006
If (dYear >= 1989) And (dYear <= 2006) And (dDay = 29) Then
MainIsSpecialHoliday = True
Aname = "みどりの日"
Exit Function
End If
' “昭和の日” 2007〜
If (dYear >= 2007) And (dDay = 29) Then
MainIsSpecialHoliday = True
Aname = "昭和の日"
Exit Function
End If
' ※皇太子明仁親王の結婚の儀(1959/04/10)
If (dYear = 1959) And (dDay = 10) Then
MainIsSpecialHoliday = True
Aname = "皇太子明仁親王の結婚の儀"
Exit Function
End If
Case 5
' 皇太子徳仁親王の天皇即位(2019/05/01)
If (dYear = 2019) And (dDay = 1) Then
MainIsSpecialHoliday = True
Aname = "天皇の即位"
Exit Function
End If
' “憲法記念日” 1948〜
If (dYear >= 1948) And (dDay = 3) Then
MainIsSpecialHoliday = True
Aname = "憲法記念日"
Exit Function
End If
' “みどりの日(2)” 2007〜
If (dYear >= 2007) And (dDay = 4) Then
MainIsSpecialHoliday = True
Aname = "みどりの日"
Exit Function
End If
' “こどもの日” 1948〜
If (dYear >= 1948) And (dDay = 5) Then
MainIsSpecialHoliday = True
Aname = "こどもの日"
Exit Function
End If
Case 6
' ※皇太子徳仁親王の結婚の儀(1993/06/09)
If (dYear = 1993) And (dDay = 9) Then
MainIsSpecialHoliday = True
Aname = "皇太子徳仁親王の結婚の儀"
Exit Function
End If
Case 7
' “海の日(1)” 1995〜2002
If (dYear >= 1995) And (dYear <= 2002) And (dDay = 20) Then
MainIsSpecialHoliday = True
Aname = "海の日"
Exit Function
End If
' “海の日(2)” 2003〜
' 第3月曜日 (五輪祝日移動法 により 2020年は23日, 2021年は22日)
If (dYear >= 2003) Then
If ((dYear = 2020) And (dDay = 23)) Or ((dYear = 2021) And (dDay = 22)) Or _
((dYear <> 2020) And (dYear <> 2021) And (Adate = FreqOfWeek(dYear, dMonth, 3, 2))) Then
MainIsSpecialHoliday = True
Aname = "海の日"
Exit Function
End If
End If
'体育の日(3)' 2020 (五輪祝日移動法)
'体育の日(4)' 2021 (五輪祝日移動法)
If ((dYear = 2020) And (dDay = 24)) Or ((dYear = 2021) And (dDay = 23)) Then
MainIsSpecialHoliday = True
Aname = "スポーツの日"
Exit Function
End If
Case 8
' “山の日” 2016〜
' 第3月曜日 (五輪祝日移動法 により 2020年は10日, 2021年は8日)
If ((dYear >= 2016) And (dYear <> 2020) And (dYear <> 2021) And (dDay = 11)) Or _
((dYear = 2020) And (dDay = 10)) Or ((dYear = 2021) And (dDay = 8)) Then
MainIsSpecialHoliday = True
Aname = "山の日"
Exit Function
End If
Case 9
' “敬老の日(1)” 1966〜2002
If (dYear >= 1966) And (dYear <= 2002) And (dDay = 15) Then
MainIsSpecialHoliday = True
Aname = "敬老の日"
Exit Function
End If
' “敬老の日(2)” 2003〜
' 第3月曜日
If (dYear >= 2003) Then
If Adate = FreqOfWeek(dYear, dMonth, 3, 2) Then
MainIsSpecialHoliday = True
Aname = "敬老の日"
Exit Function
End If
End If
' “秋分の日” 1948〜
If (dYear >= 1948) Then
If Adate = AutumnalEquinox(dYear) Then
MainIsSpecialHoliday = True
Aname = "秋分の日"
Exit Function
End If
End If
Case 10
' “体育の日(1)” 1966〜1999
If (dYear >= 1966) And (dYear <= 1999) And (dDay = 10) Then
MainIsSpecialHoliday = True
Aname = "体育の日"
Exit Function
End If
' ※即位礼正殿の儀(2019/10/22)
If (dYear = 2019) And (dDay = 22) Then
MainIsSpecialHoliday = True
Aname = "即位礼正殿の儀"
Exit Function
End If
' “体育の日(2)” 2000〜
' 第2月曜日(ハッピーマンデー) (五輪祝日移動法 により 2020年と2021年を除く)
If (dYear >= 2000) And (dYear <> 2020) And (dYear <> 2021) Then
If Adate = FreqOfWeek(dYear, dMonth, 2, 2) Then
MainIsSpecialHoliday = True
If dYear < 2020 Then
Aname = "体育の日"
Else
Aname = "スポーツの日"
End If
Exit Function
End If
End If
Case 11
' “文化の日” 1948〜
If (dYear >= 1948) And (dDay = 3) Then
MainIsSpecialHoliday = True
Aname = "文化の日"
Exit Function
End If
' “勤労感謝の日” 1948〜
If (dYear >= 1948) And (dDay = 23) Then
MainIsSpecialHoliday = True
Aname = "勤労感謝の日"
Exit Function
End If
' ※即位礼正殿の儀(1990/11/12)
If (dYear = 1990) And (dDay = 12) Then
MainIsSpecialHoliday = True
Aname = "即位礼正殿の儀"
Exit Function
End If
Case 12
' “天皇誕生日” 1948〜
If (dYear >= 1989) And (dYear <= 2018) And (dDay = 23) Then
MainIsSpecialHoliday = True
Aname = "天皇誕生日"
Exit Function
End If
End Select
End Function
'閏年なら戻り値: true
Function IsLeapYear(ByVal y As Integer) As Boolean
IsLeapYear = False
If (y Mod 400) = 0 Then
IsLeapYear = True
ElseIf (y Mod 4) = 0 And (y Mod 100) > 0 Then
IsLeapYear = True
End If
End Function
' DelphiのDecodeDateのimitation
' 日付型変数 dt を 年月日に分解して、整数型変数 yr, mn, dy にセットする
' yr, mn, dy は参照渡し
Sub DecodeDate(ByVal dt As Date, ByRef yr As Integer, _
ByRef mn As Integer, ByRef dy As Integer)
yr = Year(dt)
mn = Month(dt)
dy = Day(dt)
End Sub
※注釈: 国内/海外のWebサイトによっては(場合によっては教育機関の資料にまで…)、閏年の定義として4, 100, 400だけの規則でなく、4000で割り切れたら平年とするとか、4000または10000で割り切れたら平年とするという規則が書かれている例がありますが、閏年 (日本語版 Wikipedia) や Leap year (英語版 Wikipedia) を参照する限り、それらは今現在の定義ではないと思われます。実際に4000や10000、更には、その他の数値が書かれているWebサイトでは誤差を少なくするための提案または公式ではないと明記されていることがほとんどなので(規則であると思い込んで書いている例も一部見受けられますが…)、上記の閏年判定関数 IsLeapYear では4, 100, 400の規則だけを採用しています。
Sub Sample()
Dim HolidayName As String
Dim flg As Boolean
flg = IsSpecialHoliday("2007/3/21", HolidayName)
MsgBox flg & ":" & HolidayName
flg = IsSpecialHoliday("2007/10/8", HolidayName)
MsgBox flg & ":" & HolidayName
flg = IsSpecialHoliday("2007/4/30", HolidayName)
MsgBox flg & ":" & HolidayName
End Sub
※このページでは具体例は省略していますが、実際の運用では Adate に与える日付型文字列が、日付として妥当であるか否かを判定する関数を用意して、事前にチェックすべきです。
MsgBoxダイアログに、それぞれ
True:春分の日
True:体育の日
True:振替休日
と表示されます。
※私個人での動作確認はしていませんが、PHP版の祝日判定関数(2007年の祝日法の改正まで対応済み)は、斎藤家の自作/PHP/public_holiday.phpにあります。
また、AddinBox(祝日マクロ-1)にもVBA、C、Delphiなどでコーディングした例があります。
パラメータ str に姓または名を半角カタカナ/全角カタカナ/全角ひらがなで代入すると、そのイニシャル文字が半角英字で得られます。strに、数値など有り得ない文字列が渡された場合の戻り値は "?" です。
Function InitialLetter(ByVal str As String) As String
'strを全角ひらがなに揃える
str = StrConv(str, vbHiragana + vbWide)
If Len(str) > 1 Then
Select Case Left(str, 2)
Case "きゃ", "きゅ", "きょ": InitialLetter = "K"
Case "ぎゃ", "ぎゅ", "ぎょ": InitialLetter = "G"
Case "じゃ", "じゅ", "じょ":: InitialLetter = "J" '結果を"Z"としたい場合は書き換え
Case "ちゃ", "ちゅ", "ちょ": InitialLetter = "C" '結果を"T"としたい場合は書き換え
Case "にゃ", "にゅ", "にょ": InitialLetter = "N"
Case "ひゃ", "ひゅ", "ひょ": InitialLetter = "H"
Case "ぴゃ", "ぴゅ", "ぴょ": InitialLetter = "P"
Case "みゃ", "みゅ", "みょ": InitialLetter = "M"
End Select
End If
If InitialLetter <> "" Then
Exit Function
End If
'
Select Case Left(str, 1)
Case "あ": InitialLetter = "A"
Case "い": InitialLetter = "I"
Case "う": InitialLetter = "U"
Case "え": InitialLetter = "E"
Case "お": InitialLetter = "O"
Case "か", "き", "く", "け", "こ": InitialLetter = "K"
Case "さ", "し", "す", "せ", "そ": InitialLetter = "S"
Case "た", "ち", "つ", "て", "と": InitialLetter = "T"
Case "な", "に", "ぬ", "ね", "の": InitialLetter = "N"
'★ "ふ" を "H" にしたいなら以下の行を生かし、1つ下の行をコメントアウト
'Case "は", "ひ", "ふ", "へ", "ほ": InitialLetter = "H"
Case "は", "ひ", "へ", "ほ": InitialLetter = "H"
Case "ま", "み", "む", "め", "も": InitialLetter = "M"
Case "や", "ゆ", "よ": InitialLetter = "Y"
Case "ら", "り", "る", "れ", "ろ": InitialLetter = "R"
Case "わ", "ゐ", "ゑ", "を": InitialLetter = "W"
Case "ん": InitialLetter = "N" '氏名でイニシャルが「ん」は無いと思うけれど…
Case "が", "ぎ", "ぐ", "げ", "ご": InitialLetter = "G"
'★ "じ" を "Z" にしたいなら以下の行を生かし、1つ下の行をコメントアウト
'Case "ざ", "じ", "ず", "ぜ", "ぞ": InitialLetter = "Z"
Case "ざ", "ず", "ぜ", "ぞ": InitialLetter = "Z"
Case "だ", "ぢ", "づ", "で", "ど": InitialLetter = "D" 'でぃ,でゅなどもこれで代用
Case "ぱ", "ぴ", "ぷ", "ぺ", "ぽ": InitialLetter = "P"
Case "ば", "び", "ぶ", "べ", "ぼ": InitialLetter = "B"
Case "ヴ": InitialLetter = "V"
End Select
If InitialLetter <> "" Then
Exit Function
End If
'上記で "ふ" を "H" 表示にした場合は以下のIF文をコメントアウト
If Left(str, 1) = "ふ" Then
InitialLetter = "F"
Exit Function
End If
'上記で "じ" を "Z" 表示にした場合は以下のIF文をコメントアウト
If Left(str, 1) = "じ" Then
InitialLetter = "J"
Exit Function
End If
'-- 確定しなかった場合 "?" を返す
InitialLetter = "?"
End Function
Sub Sample()
MsgBox InitialLetter("ニッポン") & "." & InitialLetter("たろう") & "."
End Sub
→ N.T. と表示されます。
Excel 2000以降のVBAで追加されたReplace関数が必要です(なのでExcel97では動きません)
※1:改行を単純に除去した場合に単語が繋がって困る用途ならば、Replaceの第3引数を""から" "に書き換えて下さい。
※2:Excel 97で利用したい場合には、Excel 97用の代用関数 strReplace を定義した上で、以下のコード内の Replace 部分を、strReplace と書き換えて下さい。
' 文字列に含まれる改行(=vbLf/vbCR/vbCRLF)と両端の空白の除去と、
' 文字列の途中にある連続した空白を1つにまとめる関数
' xtrimは本ページで示している関数を用意すること
Function DeleteCRAndTrimSPC(ByVal str As String) As String
str = Replace(str, vbLf, "")
str = Replace(str, vbCr, "")
str = Replace(str, vbCrLf, "")
DeleteCRAndTrimSPC = xtrim(str)
End Function
§8.(1)の単純な応用例です。呼び出す前には手動/自動で範囲選択しておくことが必要です。厳密性が要求されるなら関数を呼ぶ前に対象とする範囲を含むブックやシートをActivateしておくか、この関数でIn Selectionと記されている部分を、In ActiveSheet.SelectionやIn ActiveWorkbook.ActiveSheet.Selection等に書き換えて、不適切なブックやシートを選んでしまわないようにすべきでしょう。
付記:セル内改行はvbLFだけなのが実情です。
' 選択範囲のセルの文字列に含まれる改行(=vbLf/vbCR/vbCRLF)と両端の空白の除去と、
' 文字列の途中にある連続した空白を1つにまとめる手続き
' この関数を呼ぶ前に手動またはVBAにて範囲選択をしておくこと
Sub DeleteCRAndTrimSPCInSelection()
Dim rng As Range
For Each rng In Selection
rng.Value = DeleteCRAndTrimSPC(rng.Value)
Next rng
End Sub
※実際には選択範囲全てに対して処理をせず、以下のようにintersect()を用いて、文字列とみなされるセルだけに対象を絞るのが効率的です。
Intersect(Selection, Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
但し、Intersectした結果がNothingだった場合のエラー処理を書いておきましょう。
Replace関数のないExcel 97のVBAで使えます(もちろんExcel 2003のVBAでも使えますし、WordなどのVBAでも使えます)。
文字列 strに含まれる文字列 src を、文字列 dst に置き換える関数です。
なお、dstが無指定(= "")だった場合には、文字列 str 中のsrc を除去する関数として働きます。
' Replace関数(Excel 2000から導入)の代用関数 (for Excel 97)
Function strReplace(ByVal str As String, _
ByVal src As String, ByVal dst As String) As String
Dim lStr As Integer, lSrc As Integer
Dim sLeft As String, sRight As String
Dim ptr As Integer
lStr = Len(str)
lSrc = Len(src)
sRight = str
ptr = InStr(str, src)
If lStr > 0 And lSrc > 0 And ptr > 0 Then
Do While ptr > 0
sLeft = sLeft & Left(sRight, ptr - 1) & dst
sRight = Mid(sRight, ptr + lSrc)
ptr = InStr(sRight, src)
Loop
End If
strReplace = sLeft + sRight
End Function
もしNetscape Navigator 3.0 (NN3)以降で文字列の分割をしたくなった時には、split()メソッドが利用できます。でもMicrosoft Internet Explorer 3.xx (MSIE3)ではそれが使えません。そんな時は以下のstrSplit() 関数を試してみましょう。この関数はNN3でもMSIE3でも動作します。 strSplit() は、文字列 strValue を文字列 sep で区切り、pos 番目の切り取り文字列を返します。sepの取りうる値は、文字列strValueがN個に分割された場合、0〜N-1の範囲となります。区切り文字 sep が文字列 strValue 中に存在しなかった場合や、文字列の分割数N以上の pos が指定された場合の戻り値は「null」(空文字)になります。
/*
* split() for Internet Explorer 3.xx
* and for Netscape Navigator/Communicator
* written by Seiji Fujita
*/
function strSplit(strValue , sep , pos) {
var strWord = null;
var prePtr = 0;
var postPtr = 0;
var i = 0;
var flag = false;
if (sep != '') {
while((prePtr < strValue.length) && (i <= pos)) {
postPtr = strValue.indexOf(sep, prePtr);
if (postPtr >= 0) {
strWord = strValue.substring(prePtr , postPtr);
prePtr = postPtr + sep.length;
} else {
if ((i > 0) && (flag == false)) {
strWord = strValue.substring(prePtr , strValue.length);
} else {
strWord = null;
}
flag = true;
}
i++;
}
if (i <= pos) {
strWord = null;
}
return strWord;
} else {
return null;
}
}
var vString = "A Quick brown fox jumps over the lazy dog."; var vStr4th = strSplit(vString, " ", 3); var vStr7th = strSplit(vString, " ", 6); var vStr9th = strSplit(strSplit(vString, " ", 8),".", 0); var vStr10th = strSplit(vString, " ", 9);
vStr4th の値は「fox」、vStr7th の値は「the」、vStr9th の値は「dog」、vStr10th の値は「null」(空文字)になります。
文字列に1バイト(半角)の空白と2バイト(全角)の空白が混在していて、どちらも同じく空白として扱って文字列を分割したい場合。このページで説明しているstrReplaceとxtrimとstrSplitを併用すればできます。以下は半角・全角空白が混在した英文の全角空白を半角空白に置き換えて、さらに念のためにxtrimで連続した空白を1つにまとめてから4番目の要素を取り出すサンプルコードです。
var srcStr = "A Quick brown fox jumps over the lazy dog."; var vStr4th = strSplit(xtrim(strReplace(srcStr, " ", " ", false)), " ", 3); document.write(vStr4th); → 結果として fox が表示されます。
1.(1)のstrSplit()は、同じ文字列から同じ区切り文字で文字を切り出す場合には、無駄な時間が掛ります。この関数 strSplitG()では、文字列src を区切り文字sepで区切った結果を配列 SplitWord へ出力しますので、次に別の文字列をstrSplitG()で切り出すまでは、配列要素を呼び出すだけで済み、実行時間が短縮できます(但し、関数を呼び出す度に別の文字列 src や別の区切り文字 sep で文字を切り出す必要がある場合には、おそらく strSplit()のほうが高速です)。
関数は、単語の分割数(0以上)を戻り値とします。 戻り値が0の時は、区切り文字が存在せず分割できなかった事を示し、SplitWord[0]〜SplitWord[NUM-1] は空文字(=null)となります。notfoundにfalseを与えて下さい。
※ 戻り値が0の時に、SplitWord[0] に sorg が代入される方が良い場合には、オプションパラメータnotfoundにtrueを与えて呼び出して下さい。
戻り値が-1だった場合には、単語の分割数が設定した配列の格納数より多いこと(つまり単語の分割数 > NUM + 1; 設定した配列の上限値が小さすぎたこと)を示し、SplitWord[0]〜SplitWord[NUM-1] には正しく分割した文字列が入りますが、本来切り出されるべき NUM+1 番目以降の文字列は取得できません。
この関数はNN3でもMSIE3でも動作します。
/*
* split() for Internet Explorer 3.xx
* and for Netscape Navigator/Communicator
* written by Seiji Fujita
*
* Need to declare as var SplitWord = new Array(NUM); in parent function().
* NUM: set some integer. (enought larger than maximum expected)
*
* (If you want to use SplitWord as global array,
* replace declare part with one of followings.
*
* function strSplitG(src, sep, notfound) {
*
* notfound = false
* When return value = 0 (means not found sep in src), SplitWord[0] = null
* notfound = true
* When return value = 0 (means not found sep in src), SplitWord[0] = src
*/
function strSplitG(src, sep, SplitWord, notfound) {
var prePtr = 0.0;
var postPtr = 0.0;
var flag = false;
for (var i=0; i < NUM; i++) {
SplitWord[i] = null;
}
if (sep != '') {
i = 0;
while((prePtr < src.length) && (flag == false) && (i < NUM)) {
postPtr = src.indexOf(sep, prePtr);
if (postPtr >= 0) {
SplitWord[i] = src.substring(prePtr, postPtr);
prePtr = postPtr + sep.length;
} else {
if ((i > 0) && (flag == false)) {
SplitWord[i] = src.substring(prePtr, src.length);
prePtr = src.length + 1;
}
flag = true;
}
i++;
}
if ((src.indexOf(sep, prePtr) >= 0) && (i >= NUM)) {
return -1;
} else {
if (i == 1) { //or if ((i ==1) && (SplitWord[0] == null))
if (notfound) {
SplitWord[0] = src;
}
return 0;
} else {
return i;
}
}
} else {
return 0;
}
}
var NUM = 10; var vWord = new Array(NUM); var vString = "A Quick brown fox jumps over the lazy dog."; var vCount = strSplitG(vString, " ", vWord); var vStr4th = vWord[3]; var vStr7th = vWord[6]; var vStr9th = vWord[8]; var vStr20th = vWord[19];
vCountの値は「9」、vStr4th の値は「fox」、vStr7th の値は「the」、vStr9th の値は「dog.」、vStr20th の値は「null」(空文字)となります。
※なおNUMよりも大きな添え字を与えた場合はundefinedとなります(例:NUM=10のとき、vWord[20] = undefined)
もしNetscape Navigator 3.0 (NN3)以降で数値を数字列に変換したくなった時には、toString()メソッドが利用できます。でもMicrosoft Internet Explorer 3.xx (MSIE3)ではそれが使えません。そんな時は以下のtoStr() 関数を試してみましょう。この関数はNN3でもMSIE3でも動作します。toStr()は、整数値 vNum を与える事により、その数値と等価な文字列を返します。このサンプルでは vNum に数字以外を与えた時のエラー処理はしておりませんし、小数値を与えた場合には正常動作しませんので、必要ならばその処理を追加して下さい。
/*
* toString() for Internet Explorer 3.xx
* and for Netscape Navigator/Communicator
* written by Seiji Fujita
*/
function toStr(vNum) {
var vRef = "0123456789";
var vtmpStr = "";
var vtmpNum = 0;
var vMinus = false;
if (vNum < 0) {
vMinus = true;
vNum = -vNum;
}
var vlen = Math.floor( Math.log(vNum) / Math.log(10) ) + 1;
for ( i = 1; i <= vlen; i++ ) {
vtmpNum = vNum % 10;
vNum = Math.floor(vNum / 10);
vtmpStr = vRef.charAt(vtmpNum) + vtmpStr;
}
if (vMinus)
vtmpStr = "-" + vtmpStr;
return vtmpStr;
}
var vNum1 = 12; var vNum2 = 50; var vAdd1 = vNum1 + vNum2; var vAdd2 = toStr(vNum1) + toStr(vNum2);
vAdd1 の値は数値 62、vAdd2 の値は文字列「1250」になります。
これは toStr() を任意の基数形式(2〜36進数)で出力できるように拡張した関数です。この関数はNN3でもMSIE3でも動作します。toStrExt()は、整数 vNum と 基数を指定する2から36までの整数値 radixを与える事により、vNumを等価な文字列に変換します(radixに与える数値はJavaScriptで規定された形式であれば10進数/16進数/8進数のいずれでも構いません。例:10進数で10, 16進数で 0x0a, 8進数で 012)。vNumに実数を与えても一応動作しますが、入力は整数であるとみなして動作しますので、小数点以下が切り捨てられるか切り上げられるかなどは保証しません。このサンプルでは vNum に数字以外を与えた場合や、radix に整数以外を与えた場合などのエラー処理はしておりませんので、必要なら追加して下さい。
注意:出力文字列には、その基数が何であるかを示す印は付きません。
例えば10進数の "255" を、16進数形式の文字列に変換しても、"0x" の付いた"0xff"ではなく、"ff" として出力されます。
/*
* toString() for Internet Explorer 3.xx
* and for Netscape Navigator/Communicator
* written by Seiji Fujita
*/
function toStrExt(vNum,radix) {
var vRef = "0123456789abcdefghijklmnopqrstuvwxyz";
var vtmpStr = "";
var vtmpNum = 0;
var vMinus = false;
if (vNum < 0) {
vMinus = true;
vNum = -vNum;
}
var vlen = Math.floor( Math.log(vNum) / Math.log(radix) ) + 1;
for ( i = 1; i <= vlen; i++ ) {
vtmpNum = vNum % radix;
vNum = Math.floor(vNum / radix);
vtmpStr = vRef.charAt(vtmpNum) + vtmpStr;
}
if (vMinus)
vtmpStr = "-" + vtmpStr;
return vtmpStr;
}
var vNum1 = 12; var vNum2 = 50; var vAdd1 = vNum1 + vNum2; var vAdd2 = toStrExt(vNum1,8) + toStrExt(vNum2,0x10);
vAdd1 の値は数値 62、vAdd2 の値は文字列「1432」になります。
JavaScriptを用いて文字列が数値(10進数/16進数/8進数)として評価できるかどうか調べたい時には、parseFloat() や parseInt() 関数が利用できます。けれど調べた文字列が数値でなかった時の戻り値がNetscape Navigator 3.0 (NN3)と NN2、Microsoft Internet Explorer 3.xx (MSIE3)とで異なります。NN3では特別な文字列 "NaN"、NN2とMSIE3では数値の 0 (零)です。このため、複数のブラウザで共通の関数が利用できません。そんな時は以下の isNum() 関数を試してみましょう。この関数はNN2, NN3, MSIE3で動作します。isNum()は、文字列 vInStr を与える事により、その文字列が10進数/16進数/8進数のいずれかとみなせるか否かをブール値 true (真) または false (偽) の値で答えます。
この関数は判定に際して、文字列の前部・後部にある半角・全角の空白文字は無視します(空白除去には後述する trim を利用しているため、isNumを使用する場合には、ltrim、rtrim、trimも同時に宣言する必要があります)。
[2003-09-12] 入力vInStrに、文字列ではなく数値そのものが代入されたり、半角スペースの並びだけが代入されたりした場合でも判定できるように修正対応しました。
/*
* isNum() to judge string as if decimal / hexadecimal / ocatal or not
* for Netscape Navigator/Communicator and Microsoft Internet Explorer
* written by Seiji Fujita
* return value is true or false as boolean
*/
function isNum(vInStr) {
var vRefDec = "0123456789";
var vRefOct = "01234567";
var vRefHex = "0123456789abcdefABCDEF";
var vRefSgn = "+-";
var vRefExp = "eE";
var judge = true;
var vExp = false;
var vExpSgn = false;
var vPeriod = false;
var vIn = "";
vIn = vIn + vInStr;
vIn = trim(vIn);
var vlen = vIn.length;
if ( vRefSgn.indexOf(vIn.charAt(0)) >= 0 ) {
vIn = vIn.substring(1,vlen);
vlen = vIn.length;
}
var i = 0;
isHex = vIn.indexOf("0x");
if (vlen == 0) {
judge = false;
} else if ( isHex >= 0 ) {
if ( isHex >= 1 )
judge = false;
else {
vIn = vIn.substring(2,vlen);
vlen = vIn.length;
}
while ( (judge) && (i < vlen) ) {
if ( vRefHex.indexOf(vIn.charAt(i) ) < 0 )
judge = false;
i++;
}
} else if ( (vIn.charAt(0) == "0")
&& ( vIn.charAt(1) != "." ) ) {
while ((judge) && (i < vlen)) {
if (vRefOct.indexOf(vIn.charAt(i)) < 0)
judge = false;
i++;
}
} else {
while ( (judge) && (i < vlen) ) {
if ( vRefDec.indexOf(vIn.charAt(i)) < 0 ) {
if ( vRefSgn.indexOf(vIn.charAt(i) ) >= 0 )
if ((i <= 1) || (i == vlen-1))
judge = false;
else if ( !(vExpSgn) && (vExp) && (i >= 2) )
vExpSgn = true;
else
judge = false;
else if ( vIn.charAt(i) == "." )
if ( !(vPeriod) && !(vExp) && (i < vlen-1) )
vPeriod = true;
else
judge = false;
else if ( !(vExp) && (i > 0) && (i < vlen-1)
&& (vRefExp.indexOf(vIn.charAt(i)) >= 0) )
vExp = true;
else
judge = false;
}
i++;
}
}
return judge;
}
isNum(" -1500") // true
isNum("-15.00") // true
isNum(" +15.00 ") // true [*]
isNum(" +15.00-") // false
isNum(" +15.00e+3") // true [*]
isNum(" 15.00e5") // true
isNum("15.00e-15") // true
isNum(" +15.00e+35") // true [*]
isNum(" 15.00e3.5") // false
isNum(" +15.00e+3.5") // false
isNum(" -0xfe+a") // false
isNum(" -0xfega") // false
isNum(" +0x3aea") // true [*]
isNum(" +0x3AeA") // true [*]
isNum(" +0x3a.ea") // false
実際にisNum()を評価してみるなら [評価ページ] へ。数値判定は、もっとシンプルに解決できる問題かもしれません。
目から鱗の方法→数値かどうか判断
3.(1)の結果でtrue [*]を記した文字列は、数値として問題のない形式であるにもかかわらず、NN3では(多分NN2も)eval()に代入するとエラーが起こります。エラーの原因となっているのが「+」記号なのですが、この仕様の理由が良く分かりません。MSIEでは正しく数値に変換されます。eval()を使う度に訪問者のブラウザがNN3か否かを判定するのは面倒ですし、コーディングが煩雑になりますから、 eval()を使う前には代入する文字列の前方にある「+」記号を除去しなければなりません。以下にNN2/NN3, MSIE3で動作する除去用のサンプル関数を挙げておきます。eval()では前後のスペースは問題となりませんが、この関数では前後の半角・全角の空白文字も除去します。(空白除去には、後述する trim を利用しているため、dePlusSignを使用する場合には、ltrim、rtrim、trimも同時に宣言する必要があります。)
※ Netscape Navigator 4.78では、プラス符号つきの文字をeval()に代入してもエラーとならず、正しく数値に変換されます。Opera 7.11でもOK。
/*
* function to remove prefixed "+"(plus) sign
* written by Seiji Fujita
*/
function dePlusSign(vInStr) {
var vlen = vInStr.length;
vInStr = trim(vInStr);
if (vInStr.charAt(0) == "+")
vInStr = vInStr.substring(1,vlen);
return vInStr;
}
var a = eval(dePlusSign("+3.55e5"));
実際にdePlusSign()を評価してみるなら [評価ページ] へ。
これは整数値を、Excelなどのワークシートの桁インデックスに使われている、A,B,…,Z,AA,AB,…,ZZという文字列に変換する関数です。英字だけで構成されるこの「数値」は一見すると27進数のように思えますが、27に対応する「数値」が "A "ではなく"AA"である事から見て違う事は明らかです。そのため27進数ならば728まで表現できますが、この文字列では702までしか表現できません。Visual Basic for Application (VBA)で記述した例は上に掲載しています。
/*
* 整数値(1〜702)を1桁または2桁までの英字列に変換する関数
* written by Seiji Fujita
* 出力される英字列は、A,B,…,Z,AA,AB,…,ZZ となる。
* これは1桁目が" "でない点を除いて、Excelの桁方向の数え方と同じ。
* 27進数ではない点に注意(_,A,B,…,Zの次が、A_,AA,AB,AC…となるなら27進数)
*/
function Num2Alpha(num) {
var upper = 0;
var lower = 0;
var Ref = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
var tmp = 0;
if ((num <= 0) || (num > 702))
return "ERR";
upper = Math.floor( (num - 1) / 26);
lower = (num - 1 ) % 26 + 1;
if (upper > 0)
tmp = Ref.charAt(upper - 1) + Ref.charAt(lower - 1);
else
tmp = Ref.charAt(lower - 1);
return tmp;
}
これは(1)とほとんど同じですが、英字にIとOを使わない点が異なっています。英字による番号付けの時に、1とI, 0とOとを混同しない様にするために製造業などで採用される方法です。出力される英字列は、A,B,…,H,J,…N,P,…,Z,AA,AB,…AH,AJ,…,AN,AP,…AZ,…,HZ,JA,…,NZ,PA,…PZ,…,ZZ となります。25進数とは違います。
/* 整数値(1〜600)を1桁または2桁までの英字列に変換する関数
* written by Seiji Fujita
* 出力される英字列は、A,B,〜,H,J,〜,N,P,〜Z,AA,AB,〜,AH,AJ,〜,AP,〜,ZZとなる。
* 25進数とは異なる点に注意。
*/
function Num2Alpha2(num) {
var upper = 0;
var lower = 0;
var Ref = "ABCDEFGHJKLMNPQRSTUVWXYZ";
var tmp = 0;
if ((num <= 0) || (num > 600))
return "ERR";
upper = Math.floor( (num - 1) / 24);
lower = (num - 1 ) % 24 + 1;
if (upper > 0)
tmp = Ref.charAt(upper - 1) + Ref.charAt(lower - 1);
else
tmp = Ref.charAt(lower - 1);
return tmp;
}
文字列の前・後それぞれまたは両側にある1バイトコード/2バイトコードの空白文字を除去します。
/* function to remove spaces in front of string */
function ltrim(vInStr) {
var vlen = vInStr.length;
while ((vInStr.charAt(0) == " ") || (vInStr.charAt(0) == " ")) {
vInStr = vInStr.substring(1,vlen);
vlen = vInStr.length;
}
return vInStr;
}
/* function to remove spaces at the back of string */
function rtrim(vInStr) {
var vlen = vInStr.length;
while ((vInStr.charAt(vlen-1) == " ") || (vInStr.charAt(vlen-1) == " ")) {
vInStr = vInStr.substring(0,vlen-1);
vlen = vInStr.length;
}
return vInStr;
}
文字列の左側・右側にある空白を除去する関数 ltrim と rtrim を利用してありますから、この関数を利用する場合には、それらも宣言しておくことが必要です。
/* function to remove spaces in front of/ at the back of string
* written by Seiji Fujita
*/
function trim(vInStr) {
return ltrim(rtrim(vInStr));
}
文字列の左側・右側にある空白を除去する関数 trim を利用していますから、この関数を利用する場合には、ltrim と rtrim と trim を宣言しておくことが必要です。
文字列中に存在する連続した空白は1つの空白(1バイトコード)に置換されます。
/* function to remove spaces in front of/ at the back of string
* and to shrink series spaces within string into a space.
* written by Seiji Fujita
*/
function xtrim(vInStr) {
vInStr = trim(vInStr);
var i = 1;
while (i < vInStr.length) {
if (vInStr.charAt(i) == " ")
vInStr = vInStr.substring(0, i) + " " + vInStr.substring(i+1, vInStr.length);
if ((vInStr.charAt(i) == " ") && ((vInStr.charAt(i+1) == " ") || (vInStr.charAt(i+1) == " "))) {
vInStr = vInStr.substring(0, i) + " " + vInStr.substring(i+2, vInStr.length);
} else {
i++;
}
}
return vInStr;
}
もしMicrosoft Internet Explorer 4.xx (MSIE4)以降やNetscape Navigator 4.0 (NN4)以降で文字列の置換をする場合には、replace()メソッドが利用できます。しかし古いブラウザではそのメソッドが使えません。そんな場合は、以下のstrReplace() 関数を試してみましょう。この関数はNN3でもMSIE3でも動作します。もちろんMSIE4以降/NN4以降/Operaでも動作します。strReplace() は、文字列 strOrgに含まれる文字列 ssrc を、文字列 sdest に置き換える関数です。
なお、vsdestが無指定(=空)だった場合には、文字列strOrg中のssrcを除去する関数として働きます。
gflag がtrueの時、ssrcに一致した文字列全てを置換し、gflag がfalseの時、ssrcに一致した最初の文字列だけを置換します。
iflag がtrueの時、文字列 ssrcと文字列 strOrg の1byte英字の大文字・小文字を無視します。
文字列 ssrc が、文字列 strOrg に含まれない場合の戻り値は、strOrg そのままの値となります。なお、同じ文字列に置換するような場合(「a」を「a」や「abc」に置換したり、「あ」を「あ」や「あいう」に置換するような場合)でも無限ループにならないように、置換した文字を再置換しないよう考慮してあります。
/* replace string function
* written by Seiji Fujita
*
* Replace string "ssrc" in strOrg by "sdest".
* If ssrc is not found in strOrg, return value is strOrg as it is.
* gflag = false : replace first string matched "ssrc" only.
* = true : replace every string matched "ssrc".
* iflag = true : ignore case distinctions in both "ssrc" and "strOrg".
*/
function strReplace(strOrg, ssrc, sdest, gflag, iflag) {
var slOrg = strOrg.length;
var slSrc = ssrc.length;
var sleft = "";
var sright = strOrg;
if (iflag) {
var sisrc = ssrc.toLowerCase();
var pos = strOrg.toLowerCase().indexOf(sisrc);
if ((slOrg > 0) && (slSrc > 0) && (pos >= 0)) {
while(pos >= 0) {
sleft = sleft + sright.substring(0, pos) + sdest;
sright = sright.substring(pos + slSrc, slOrg);
slOrg = sright.length;
pos = sright.toLowerCase().indexOf(sisrc);
if (!gflag) {
pos = -1;
}
}
}
} else {
var pos = strOrg.indexOf(ssrc);
if ((slOrg > 0) && (slSrc > 0) && (pos >= 0)) {
while(pos >= 0) {
sleft = sleft + sright.substring(0, pos) + sdest;
sright = sright.substring(pos + slSrc, slOrg);
slOrg = sright.length;
pos = sright.indexOf(ssrc);
if (!gflag) {
pos = -1;
}
}
}
}
return sleft + sright;
}
実際にstrReplace()を評価してみるなら [評価ページ] へ。※ 古いブラウザを考慮しなければ、(a) string.split()メソッドと string.join()メソッドの組合せや、(b) 正規表現オブジェクト RegExp()と string.replace()メソッドの組合せでも実現できます。