マクロというものを作ってみました。
マイクロソフトサポート
マクロ記録で作業を自動化する
・IF 関数
IF 関数は Excel で頻繁に使用される関数の 1 つであり、ある値と期待値を論理的に比較できます。そのため、IF ステートメントには 2 つの結果があります。 1 つ目の結果は比較が True の場合であり、2 つ目の結果は比較が False の場合です。たとえば、=IF(C2=”Yes”,1,2) の意味は次のようになります。IF(C2 = Yes の場合は 1 を返し、それ以外の場合は 2 を返します)。
IF 関数=IF(C2=ファミリーマート,”Yes”,”No”)
C2番地にファミリーマートが建っている場合はYES,それ以外はNoと表示される。
・INDEX関数
＝INDEX(配列, 行番号, [列番号])
選択した土地にある交差点に、何が建っているかを表示する。VLOOKUP関数は左側通行。
MATCH 関数
=MATCH(検査値, 検査範囲, [照合の型])
選択したラーメンが、その範囲で何番目に美味しいか表示する。
INDEX と MATCH の例
この最後の例では、INDEX 関数と MATCH 関数を組み合わせて使用して、5 都市ごとに最も早い請求書番号と対応する日付を返します。 日付は数値として返されるので、TEXT 関数を使用して日付として書式設定します。 INDEX 関数は、実際には MATCH 関数の結果を引数として使用します。 INDEX 関数と MATCH 関数の組み合わせは、最初に請求書番号を返し、次に日付を返す場合に、各数式で 2 回使用されます。
次の表のすべてのセルをコピーし、Excel の空のワークシートのセル A1 に貼り付けます。
・セルの条件付き書式・装飾のクリア・・・ホーム→条件付き書式→ルールのクリア。
・シートの数式を表示・・・ファイル→その他→オプション→詳細設定→次のシートで作業するときの表示設定→計算結果の代わりに数式をセルに表示する。
成年被後見人の死亡後の死体の火葬又は埋葬に関する契約の締結その他相続財産の保存に必要な行為についての許可申立書
VLOOKUP関数
=VLOOKUP(B2,C2:E7,3,TRUE)
この例では、B2 は最初の引数 (関数が動作する必要があるデータの要素) です。 VLOOKUP の場合、この最初の引数は検索する値です。 この引数には、セル参照、または “smith” や 21,000 などの固定値を指定できます。 2 番目の引数は、検索する値を検索するセル範囲 C2~:E7 です。 3 番目の引数は、シークする値を含むセル範囲内の列です。
4 番目の引数は省略できます。 TRUE または FALSE を入力します。 「TRUE」を入力するか、この引数を空白のままにすると、最初の引数で指定した値に最も近いものが関数の結果として返されます。 FALSE を入力すると、関数は最初の引数で指定された値と一致します。 つまり、4 番目の引数を空白のままにするか、TRUE を入力すると、柔軟性が向上します。
この例では、この関数のしくみを説明します。 セル B2 (最初の引数) に値を入力すると、VLOOKUP はセル範囲 C2:E7 (第 2 引数) のセルを検索し、範囲内の 3 番目の列である列 E (3 番目の引数) から最も近い近似一致を返します。
=VLOOKUP(ルックアップ値、ルックアップ値を含む範囲、戻り値を含む範囲内の列番号、近似一致 (TRUE)、または完全一致 (FALSE))。
=VLOOKUP(‘沖縄県’!A2,’沖縄県’!:A3：D10,2,FALSE)
沖縄で１番美味しいお店を、東京都青梅市○○番地に表示。お店の範囲は、糸満市字糸満３番から名護市名護字10番まで。
https://note.com/nakamu_cpa/n/n6ab68edae67a
上の記事を加工してみました。
Option Private Module
Sub E_Gav(eType As Long, Article As Long, Plus As Long, Item As Long, f As UserForm)
Dim objXMLHttp As Object, XMLstr As String, str As String, tx As String, Bodystr As String, V(20), n(20)
'--------------------------------------------------------------------------------
' HTTP通信用定義。
'--------------------------------------------------------------------------------
Dim i As Long, num As Long, tmp As String, ArtStr As String, KakkoFlg As Long
Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
objXMLHttp.Open "GET", E_URL(eType, Article, Plus, ArtStr)
objXMLHttp.Send
'--------------------------------------------------------------------------------
'HTTPリクエストをするIXMLHTTPRequestオブジェクト。
'文字列変換｡指定した数だけ繰り返した文字列を取得｡階差有り｡
'--------------------------------------------
For i = 1 To 100000
If objXMLHttp.readyState = 4 Then Exit For
DoEvents
If i = 100000 Then MsgBox "終了": Exit Sub
'--------------------------------------------------------------------------------
'100000回実行したら、プログラムは終了（一旦ファイルを閉じる。）
'--------------------------------------------
Next
XMLstr = objXMLHttp.responseText
f.Title = E_StrSearch(XMLstr, "ArticleCaption")
For i = 1 To 20
n(i) = E_NoSearch(XMLstr, "Paragraph", i)
If n(i) = 0 Then n(i) = E_NoSearch(XMLstr, "Paragraph Hide=""false""", i)
If n(i) = 0 Then n(i) = Len(XMLstr)
'--------------------------------------------------------------------------------
'返す文字列の定義。条、項、号。
'--------------------------------------------
Next
For i = 1 To 20
If n(i + 1) = n(i) Then Exit For
For j = n(i) To n(i + 1)
tmp = Mid(XMLstr, j, 1)
If tmp = ">" Then
flg = True
ElseIf tmp = "<" Then
flg = False
End If
If flg And tmp <> ">" And tmp <> " " Then
V(i) = V(i) & tmp
End If
'--------------------------------------------------------------------------------
'見回りを止めて文字列を返す場合を定義。tmp・・・一時的に値を格納。
'--------------------------------------------
Next
V(i) = Replace(V(i), vbLf, "\")
V(i) = Replace(V(i), vbCrLf, "\")
V(i) = Replace(V(i), vbCr, "\")
V(i) = Replace(V(i), "\" & "\" & "\" & "\", "\")
V(i) = Replace(V(i), "\" & "\" & "\", "\")
V(i) = Replace(V(i), "\" & "\", "\")
If Left(V(i), 1) = "\" Then V(i) = Mid(V(i), 2)
If Right(V(i), 1) = "\" Then V(i) = Mid(V(i), 1, Len(V(i)) - 1)
If IsNumeric(Left(V(i), 1)) Then V(i) = Mid(V(i), 2)
If Left(V(i), 1) = "\" Then V(i) = Mid(V(i), 2)
V(i) = Replace(V(i), "\", "<Br>")
'--------------------------------------------------------------------------------
'置き換え。セル内・メッセージボックス改行。文字結合。
'--------------------------------------------
Next
tx = "<b>" & f.Controls("OptionButton" & eType).Caption & ArtStr & "</b><Br>"
For i = 1 To 20
If V(i) <> "" Then
If i = Item Then tx = tx & "<FONT COLOR=#0000DD>"
tx = tx & "<b>【第" & i & "項】</b>" & "<Br>" & V(i) & "<Br>"
If i = Item Then tx = tx & "</FONT>"
End If
'--------------------------------------------------------------------------------
'表示されるフォームの設定。
'--------------------------------------------
Next
KakkoFlg = 0
For j = 1 To Len(tx)
tmp = Mid(tx, j, 1)
If tmp = "（" Or tmp = "(" Then
Bodystr = Bodystr & "<FONT COLOR=#777777>（"
KakkoFlg = KakkoFlg + 1
ElseIf tmp = "）" Or tmp = ")" Then
Bodystr = Bodystr & "）</FONT>"
KakkoFlg = KakkoFlg - 1
ElseIf Mid(tx, j, 1) = "。" And KakkoFlg = 0 Then
Bodystr = Bodystr & "<b>。</b>"
ElseIf Mid(tx, j, 2) = "場合" Then
Bodystr = Bodystr & "<FONT COLOR=#009900>場合</FONT>"
j = j + 1
ElseIf Mid(tx, j, 2) = "とき" Then
Bodystr = Bodystr & "<FONT COLOR=#009900>とき</FONT>"
j = j + 1
ElseIf Mid(tx, j, 2) = "除く" Then
Bodystr = Bodystr & "<FONT COLOR=#FF3366>除く</FONT>"
j = j + 1
ElseIf Mid(tx, j, 2) = "及び" Then
Bodystr = Bodystr & "<FONT COLOR=#FF9900>および</FONT>"
j = j + 1
ElseIf Mid(tx, j, 3) = "並びに" Then
Bodystr = Bodystr & "<FONT COLOR=#FFCC00>並びに</FONT>"
j = j + 2
ElseIf Mid(tx, j, 2) = "又は" Then
Bodystr = Bodystr & "<FONT COLOR=#FF9900>又は</FONT>"
j = j + 1
ElseIf Mid(tx, j, 4) = "若しくは" Then
Bodystr = Bodystr & "<FONT COLOR=#FFCC00>若しくは</FONT>"
j = j + 3
ElseIf Mid(tx, j, 3) = "ただし" Then
Bodystr = Bodystr & "<FONT COLOR=#FF0000><b>ただし</b></FONT>"
j = j + 2
ElseIf InStr("一二三四五六七八九十百千", tmp) > 0 Then
num = E_number(num, tmp)
ElseIf num <> 0 Then
Bodystr = Bodystr & num & tmp
num = 0
Else
Bodystr = Bodystr & tmp
End If
'--------------------------------------------------------------------------------
'括弧書きフラグ。開始位置、場合、とき等の処理。
'--------------------------------------------
Next
With f.WebBrowser1
.Navigate "about:blank"
DoEvents
.Document.Write "<HTML>"
.Document.Write "<HEAD>"
.Document.Write "<font size=""3"" face=""Meiryo UI"">"
.Document.Write Replace(Bodystr, "_未", "<FONT COLOR=red>_未</FONT>")
.Document.Write "</BODY>"
.Document.Write "</HTML>"
.Document.Body.Style.overflow = "hidden"
End With
End Sub
'--------------------------------------------------------------------------------
'今後、htmlなどを省略する。
'--------------------------------------------
Function E_number(n As Long, tmp As String)
Select Case tmp
Case "一"
E_number = n + 1
Case "二"
E_number = n + 2
Case "三"
E_number = n + 3
Case "四"
E_number = n + 4
Case "五"
E_number = n + 5
Case "六"
E_number = n + 6
Case "七"
E_number = n + 7
Case "八"
E_number = n + 8
Case "九"
E_number = n + 9
Case "十"
buf = n Mod 10
If buf = 0 Then buf = 1
E_number = Int(n / 100) * 100 + buf * 10
Case "百"
buf = n Mod 10
If buf = 0 Then buf = 1
E_number = Int(n / 1000) * 1000 + buf * 100
Case "千"
buf = n Mod 10
If buf = 0 Then buf = 1
E_number = Int(n / 10000) * 10000 + buf * 1000
End Select
End Function
'--------------------------------------------------------------------------------
'開始文字で分ける準備。十、百、千は次の文字列を探す。
'--------------------------------------------
Function E_NoSearch(XMLstr As String, str As String, no As Long) As Long
E_NoSearch = InStr(XMLstr, "<" & str & " Num=""" & no & """>")
End Function
'--------------------------------------------------------------------------------
'<で始まり、>で終わらない文字列は検索から弾く。
'--------------------------------------------
Function E_StrSearch(XMLstr As String, str As String) As String
Dim wLen As Long, wStartPoint As Long, wEndPoint As Long
wLen = Len(str)
wStartPoint = InStr(XMLstr, "<" & str & "") + wLen + 2
wEndPoint = InStr(XMLstr, "</" & str & ">")
If wEndPoint - wStartPoint < 1 Then Exit Function
E_StrSearch = Mid(XMLstr, wStartPoint, wEndPoint - wStartPoint)
End Function
'--------------------------------------------------------------------------------
'<,/,>なども文字列として返す。
'--------------------------------------------
Function E_URL(Typ As Long, Article As Long, Plus As Long, ArtStr As String) As String
Dim ArtUrl As String, LawUrl As String, TmpRng As Range
Select Case Typ
Case 1
LawUrl = encodeURL("明治二十九年法律第八十九号")
Case 2
LawUrl = encodeURL("平成十六年法律第百二十三号")
Case 3
LawUrl = encodeURL("平成十六年政令第三百七十九号")
Case 4
LawUrl = encodeURL("平成十七年法務省令第十八号")
Case 5
LawUrl = encodeURL("平成十七年法律第八十六号")
Case 6
LawUrl = encodeURL("平成十七年法律第八十七号")
Case 7
LawUrl = encodeURL("平成十八年法務省令第十二号")
Case 8
LawUrl = encodeURL("昭和三十八年法律第百二十五号")
Case 9
LawUrl = encodeURL("昭和三十九年法務省令第二十三号")
Case 10
LawUrl = encodeURL("平成十九年法律第二十二号")
Case 11
LawUrl = encodeURL("昭和二十五年法律第百九十七号")
Case 12
LawUrl = encodeURL("昭和二十二年法律第二百二十四号")
Case 13
LawUrl = encodeURL("昭和二十二年司法省令第九十四号")
Case 14
LawUrl = encodeURL("平成十八年法律第百八号")
Case 15
LawUrl = encodeURL("平成十九年法務省令第四十一号")
Case 16
LawUrl = encodeURL("昭和三十二年法律第二十六号")
End Select
For i = 1 To 9999 'NUMBERSTRINGが関数としてしか動かないので空いてるセルを探して一時使用
If Cells(1, i) = "" Then Set TmpRng = Cells(1, i): Exit For
Next
TmpRng.FormulaR1C1 = "=NUMBERSTRING(" & Article & ",1)"
Calculate
ArtStr = "第" & TmpRng.Value & "条"
If Plus <> 0 Then
TmpRng.FormulaR1C1 = "=NUMBERSTRING(" & Plus & ",1)"
Calculate
ArtStr = ArtStr & "の" & TmpRng.Value
End If
TmpRng.Value = ""
ArtUrl = encodeURL(ArtStr)
E_URL = "https://elaws.e-gov.go.jp/api/1/articles;lawNum=" & LawUrl & ";article=" & ArtUrl
End Function
'--------------------------------------------------------------------------------
'別のファイルからExcelファイルに格納する。法令検索APIから「1」の法令を取得。
'--------------------------------------------
Function encodeURL(ByRef str As String) As String
For i = 1 To 9999
If Cells(i, 1) = "" Then Set TmpRng = Cells(i, 1): Exit For
Next
TmpRng.FormulaR1C1 = "=ENCODEURL(""" & str & """)"
Calculate
encodeURL = TmpRng.Value
TmpRng.Value = ""
End Function
'--------------------------------------------------------------------------------
'UTF-8をサポートする。
'--------------------------------------------
法令番号ではなく、法令IDを使いたい、など色々改善点はありますが、まずExcelで作ってみる。使えそうなら別のコードを書いてみる、という方法は良いんじゃないかなと思いました。Excelの魅力は使い慣れている、環境構築がほとんど不要、というところではないでしょうか。
