取得した条文を整形して、
読みやすく加工する
<<第1回 <第4回 第6回>
↑今回の成果ヽ(`▽´)/ |
必要なもの:
・自己責任を許容できる寛容な心・プログラムをトライ&エラーできる程度の時間と勇気
・vlookupがどのように働くのか、理解できる程度の表計算経験
(今回はvlookup使わないですが、似たような概念は使ってます)
・BASICのプログラム経験
簡単な解説:
条文は条文シートから1行づつ取ってきているので、そのタイミングで整形することにした。
整形専用のサブルーチン
- 条、項、号、イロハは行を変え、インデントをつけて表示する
- 行に含まれる漢数字は”全て”アラビア数字に変換(変換パターン2つに対応w)
- 百十条 → 110条
- 百十条 → 一一〇条 ←後で使う事になるのさ
- 逆変換はできません(;・∀・)
↑おおかたこんな感じの表示になります |
↑無慈悲な変換w |
LibreOffice(≒OpenOffice)には無いらしい…ので、あえなく自作せざるを得ない。
・文字列置換関数
・漢数字をアラビア数字に変化する関数
'一行整形サブルーチン
Function reformoneline(oneline as string)
oneline = oneline + chr(13) + chr(13) ' 条、項の後には改行を
' 号は桁を下げる
if instr(1, oneline, "一") = 1 or instr(1, oneline, "二") = 1 or instr(1, oneline, "三") =1 or instr(1, oneline, "四") =1 or instr(1, oneline, "五") =1 _
or instr(1, oneline, "六") =1 or instr(1, oneline, "七") =1 or instr(1, oneline, "八") =1 or instr(1, oneline, "九") =1 then
oneline = " " + oneline
end if
' イロハニ
if instr(1, oneline, "イ") = 1 or instr(1, oneline, "ロ") = 1 or instr(1, oneline, "ハ") =1 or instr(1, oneline, "ニ") =1 or instr(1, oneline, "ホ") =1 _
or instr(1, oneline, "ヘ") =1 or instr(1, oneline, "ト") =1 or instr(1, oneline, "チ") =1 or instr(1, oneline, "リ") =1 then
oneline = " " + oneline
end if
oneline = replace(oneline,"若しくは"," 若しくは ")
oneline = replace(oneline,"又は"," 又は ")
oneline = replace(oneline,"及び"," 及び ")
oneline = replace(oneline,"並びに"," 並びに ")
oneline = replace(oneline,"あつた", "あった")
oneline = replace(oneline,"かつた", "かった")
oneline = replace(oneline,"かつ"," かつ ") ' ←且つ
oneline = reFMT(oneline,1) ' 1条文中の漢数字をアラビア数字に変換
reformoneline = oneline
end function
Sub changeJoubunField(someAjobun as string)
oDialog.getControl("TextField1").text = someAjobun
end sub
' 漢数字変換サブルーチン
' 文字列中の漢数字を全て入れ替える
' 一般漢数字の千まで対応できるはず
function reFMT(nKnj as string, sw as integer)
Dim nArb as string
Dim nLen as Integer
Dim tmp0 as integer
Dim tmp1 as integer
Dim tmp2 as integer
Dim tmp3 as integer
Dim total as integer
if nKnj = "" then
reFMT = ""
end if
nLen = len(nKnj)
for i=1 to nLen
if mid(nknj, i, 1) = "一" then
tmp0 = 1
elseif mid(nknj, i, 1) = "二" then
tmp0 = 2
elseif mid(nknj, i, 1) = "三" then
tmp0 = 3
elseif mid(nknj, i, 1) = "四" then
tmp0 = 4
elseif mid(nknj, i, 1) = "五" then
tmp0 = 5
elseif mid(nknj, i, 1) = "六" then
tmp0 = 6
elseif mid(nknj, i, 1) = "七" then
tmp0 = 7
elseif mid(nknj, i, 1) = "八" then
tmp0 = 8
elseif mid(nknj, i, 1) = "九" then
tmp0 = 9
elseif mid(nknj, i, 1) = "十" then
if tmp0>0 then
tmp1=tmp0*10
tmp0=0
else
tmp1=10
endif
elseif mid(nknj, i, 1) = "百" then
if tmp0>0 then
tmp2=tmp0*100
tmp0=0
else
tmp2=100
endif
elseif mid(nknj, i, 1) = "千" then
if tmp0>0 then
tmp3=tmp0*1000
tmp0=0
else
tmp3=1000
endif
else
total = tmp0 + tmp1 + tmp2 + tmp3
if total >0 then
nArb = nArb & total & mid(nknj, i, 1)
else
nArb = nArb & mid(nknj, i, 1)
end if
tmp0=0
tmp1=0
tmp2=0
tmp3=0
end if
next i
Dim nArbKnj as string
nLen = len(nArb)
for i = 1 to nLen
tmp = Mid(nArb, i, 1)
if tmp = "1" then
tmp="一"
elseif tmp = "2" then
tmp = "二"
elseif tmp = "3" then
tmp ="三"
elseif tmp = "4" then
tmp ="四"
elseif tmp = "5" then
tmp ="五"
elseif tmp = "6" then
tmp ="六"
elseif tmp = "7" then
tmp ="七"
elseif tmp = "8" then
tmp ="八"
elseif tmp = "9" then
tmp ="九"
elseif tmp = "0" then
tmp ="〇"
else
end if
nArbKnj=nArbKnj & tmp
next i
if sw = 1 then
reFMT = nArb
elseif sw = 0 then
reFMT = nArbKnj
end if
end function
Function ReplacePlural(strData, strReplace, avarFind) As String
'概要 : 文字列内を指定の複数の文字列で検索して一括置換する
'引数 : strData 置換対象の元の文字列
' strReplace 置換後の文字列
' avarFind 検索する文字列(任意の複数の文字列を指定可)
'返り値 : 置換後の文字列
Dim schar As Variant
Dim Result as String
Result = strData
For Each schar In avarFind
Result = Replace(Result, schar, strReplace)
Next schar
ReplacePlural = Result
End Function
Function Replace(Source As String, Search As String, NewPart As String)
Dim Result As String
Dim StartPos As Long
Dim CurrentPos As Long
Result = ""
StartPos = 1
CurrentPos = 1
If Search = "" Then
Result = Source
Else
Do While CurrentPos <> 0
CurrentPos = InStr(StartPos, Source, Search)
If CurrentPos <> 0 Then
Result = Result + Mid(Source, StartPos, _
CurrentPos - StartPos)
Result = Result + NewPart
StartPos = CurrentPos + Len(Search)
Else
Result = Result + Mid(Source, StartPos, Len(Source))
End If ' Position <> 0
Loop
End If
Replace = Result
End Function
Function changNKNJtoNARB(nknj as string)
end Function