2019/11/23

自分専用の関数を作る

０．はじめに
１．（おさらい）計算や検索を行うサイトからデータを取得する方法
２．自分用関数の作り方
３．SUBプロシージャとFunctionプロシージャの違い
４．マクロのFunction改造
５．他人のサイトを計算に使用する場合の注意点

０．はじめに

別項目「計算や検索を行うサイトからデータを取得する」で、他のサイトにデータを送って結果を受け取る、というプログラムを作りましたが、その時は、INPUTボックスに１回１回データをタイプ入力し、結果もMSGBOXに表示される、というものでした。
１個や２個のデータでしたら気になりませんし、そもそもExcelで作らなくてもそのサイトに直接行った方が速そうです。Excelで作る、ということは大量のデジタルデータを一気に処理できる、という所に魅力があるわけです。
ということで、大量データに対応した手法を紹介します。

１．（おさらい）計算や検索を行うサイトからデータを取得する方法

INPUTボックスに入れたデータ（文字列）を結果表示ページに直接送り、そのHTMLソースから結果を探し出しMSGBOXで表示する、というものです。このプログラムは「マクロ実行」などの方法で読み出して実行するものです。
「計算や検索を行うサイトからデータを取得する」を参照下さい

Sub main()
　Dim st As String　　　'入力する文字列
　Dim paramStr As String　　　'ページにデータを渡すPOSTパラメータ
　Dim xmlhttp As Object　　　'ｻｰﾊﾞとのHTTP通信を行うための組込みｵﾌﾞｼﾞｪｸﾄ（XMLHttpRequestｵﾌﾞｼﾞｪｸﾄ）
　Dim retCd As String　　　　'結果コード（コード200であれば正常）
　Dim retHtml As String　　　'結果ＨＴＭＬ
　Dim retStr As String　　　　'結果データ
　Dim Position1 As Integer　'ソース中での位置（結果データの手前側）
　Dim Position2 As Integer　'ソース中での位置（結果データの後側）
　Const url As String = "http://atsumitm.iobb.net/it/test_keisan1.php"
　Const StartStr1 As String = "MD5ハッシュ値</td>"　　'目的ワードの手前で特徴的な言葉・記号
　Const StartStr2 As String = "<td>"　　　'目的のワードの直前の記号
　Const EndStr1 As String = "</td>"　　　　　'目的のワードの直後の記号
　st=inputbox("文字列を入力して下さい")
　　If st = "" Then
　　　Exit Sub
　　End if
　paramStr = "&moji=" & st
　Set xmlhttp = CreateObject("msxml2.xmlhttp")
　xmlhttp.Open "POST", url, False 　　'url2との接続
　xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"　　'HTTPリクエストヘッダ値を設定
　xmlhttp.send (paramStr)　　　'パラメータを送付
　retCd = xmlhttp.Status　　　'結果コードを取得
　If retCd <> 200 Then
　　retStr= "Error番号:" & retCd
　Else
　　retHtml = StrConv(xmlhttp.responseBody, vbUnicode) 　 '結果HTML取得
　　Position1 = InStr(retHtml, StartStr1) + Len(StartStr1)
　　Position1 = InStr(Position1, retHtml, StartStr2) + Len(StartStr2)
　　Position2 = InStr(Position1, retHtml, EndStr1)
　　retStr = Mid(retHtml, Position1, Position2 - Position1)
　　　if retStr = "" then retStr = "データがありません"
　End If
　MsgBox (st & vbCrLf & retStr)
　Set xmlhttp = Nothing
End Sub

このプログラムですと初めに説明した通り、INPUTボックスを使用している為、結果は１つずつしか得られません。

２．自分用関数の作り方

Excelには、組み込みワークシート関数が400種類以上が存在します。例えば「=SUM(A1:A5)」などが真っ先に出てくる関数でしょうが、「自分のやりたい事を表現してくれる関数が、どうしても見つからない」という事もあると思います。
そういう時に、自分専用の関数（カスタム関数）を作る方法を覚えておくと便利です。

カスタム関数はVBAで作成し、標準モジュールに記入します。まずは、以下のコードを標準モジュールに貼って下さい。

Function zeikomi(kakaku As Long, keigen As Boolean, hizuke As Date)
　If hizuke >= DateSerial(2019, 10, 1) Then　　'2019/10/1の10%開始より後か
　　If keigen = True Then　　　　　　　　　'軽減税率の対象か
　　　zeikomi = kakaku * 1.08　　　　　　　'軽減税率対象での税込み価格
　　Else
　　　zeikomi = kakaku * 1.1　　　　　　　　'軽減税率対象以外での税込み価格
　　End If
　Else
　　zeikomi = kakaku * 1.08　　　　　　　　'9/30までの8%税込み価格
　End If
　zeikomi = Int(zeikomi)　　　　　　　　　　'1円未満を切り捨て
End Function

貼り付けた後、下図のようにワークシート上で「日付」「価格」「軽減税率」の列を作り、別の列で数式として、
　　　=zeikomi(価格 , 軽減税率対象有無 , 買った日付)　　　を入力します。

ちゃんと税込み価格が計算できていますよね。
但し、この位の計算であれば、以下の数式で表現できてしまいます。
　　　=INT(IF(A2>=DATE(2019,10,1),(IF(C2,B2*1.08,B2*1.1)),B2*1.08))

３．SUBプロシージャとFunctionプロシージャの違い

では、下のような「ハッシュ値」の一覧を作りたい場合はどうでしょう。

一番上のマクロは使えますが、１つ１つ文字列を入力しなくてはならず多くの文字列を処理するには大変です。また、残念ながらExcelの組み込み関数には無さそうです。
こういう時こそカスタム関数の出番です。

まずワークシート関数として使えるように改造するに当たり、SUBプロシージャとFunctionプロシージャの違いを整理してみましょう。
（尚、各プロシージャとも色々な使い方が出来ます。とりあえず一番上のマクロに限っての表です）

	SUBプロシージャ	Functionプロシージャ
プロシージャの始まり	SUB＋プロシージャ名	Function＋プロシージャ名
入力方法	inputboxなど	プロシージャの引数
出力方法	msgboxなど	プロシージャ名に戻り値を渡す
プロシージャの終わり	END SUB	END Function

４．マクロのFunction改造

上の表の「SUBプロシージャとFunctionプロシージャの違い」を確認しながら改造をしていきましょう。
まず、プロシージャの始まりと終わりを変更します。途中で抜ける「Exit・・」も忘れずに変更します。
変更するに当たり、プロシージャ名はワークシート関数として登録されていないものであれば問題ないのですが、後から見て分かり易い名前が良いので、ここではハッシュ名を使った「hash_md5」にしました。
（ちなみに、単純に「md5」としてしまうとセルの「MD5」番地を指してしまいますのでプロシージャ名には使えません）

Function hash_md5()
・・・・
　　If st = "" Then
　　　~~Exit Sub~~　
　　　Exit Function
　　End if
・・・・
End Function

次に、入力としてはSUBプロシージャのinputbox の戻り値を入れていた関数「st」を使いましょう。型はString　です。

Function md5(st As String)
　Dim st As String　　　'入力する文字列
・・・・
　~~st=inputbox("文字列を入力して下さい")~~
・・・・
End Function

最後に、出力として「md5=〇〇」を加えます。

Function md5(st As String)
・・・・
　　If st = "" Then
　　　hash_md5 = ""　　'←追加行
　　　Exit Function
　　End If
・・・・
　~~MsgBox (st & vbCrLf & retStr)~~
　hash_md5 = retStr　　'←追加行
・・・・
End Function

以上です。結構簡単ですね。変更を加えたFunctionプロシージャを全て書いてみます。

Function hash_md5(st As String)
　Dim paramStr As String　　　'ページにデータを渡すPOSTパラメータ
　Dim xmlhttp As Object　　　'ｻｰﾊﾞとのHTTP通信を行うための組込みｵﾌﾞｼﾞｪｸﾄ（XMLHttpRequestｵﾌﾞｼﾞｪｸﾄ）
　Dim retCd As String　　　　'結果コード（コード200であれば正常）
　Dim retHtml As String　　　'結果ＨＴＭＬ
　Dim retStr As String　　　　'結果データ
　Dim Position1 As Integer　'ソース中での位置（結果データの手前側）
　Dim Position2 As Integer　'ソース中での位置（結果データの後側）
　Const url As String = "http://atsumitm.iobb.net/it/test_keisan1.php"
　Const StartStr1 As String = "MD5ハッシュ値</td>"　　'目的ワードの手前で特徴的な言葉・記号
　Const StartStr2 As String = "<td>"　　　'目的のワードの直前の記号
　Const EndStr1 As String = "</td>"　　　　　'目的のワードの直後の記号
　　If st = "" Then
　　　hash_md5 = ""
　　　Exit Function
　　End If
　paramStr = "&moji=" & st
　Set xmlhttp = CreateObject("msxml2.xmlhttp")
　xmlhttp.Open "POST", url, False 　　'url2との接続
　xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"　　'HTTPリクエストヘッダ値を設定
　xmlhttp.send (paramStr)　　　'パラメータを送付
　retCd = xmlhttp.Status　　　'結果コードを取得
　If retCd <> 200 Then
　　retStr= "Error番号:" & retCd
　Else
　　retHtml = StrConv(xmlhttp.responseBody, vbUnicode) 　 '結果HTML取得
　　Position1 = InStr(retHtml, StartStr1) + Len(StartStr1)
　　Position1 = InStr(Position1, retHtml, StartStr2) + Len(StartStr2)
　　Position2 = InStr(Position1, retHtml, EndStr1)
　　retStr = Mid(retHtml, Position1, Position2 - Position1)
　　　if retStr = "" then retStr = "データがありません"
　End If
　hash_md5 = retStr
　Set xmlhttp = Nothing
End Function

この自作関数「hash_md5(文字列)」を使って、ワークシートの計算をさせましょう。無事にMD5ハッシュ値が算出されました。また、空セルの場合（下の例の10行目）は空（""）が戻されるようになっています。

５．他人のサイトを計算に使用する場合の注意点

なお、この例のように他の人のサイトを使って計算をする場合は、注意が必要です。計算の都度、そのサイトにアクセスを繰り返すため、悪くすると「サイトが攻撃されている」と受け取られるからです。（アクセスを停止される可能性もあり、最悪では攻撃者とみなされて訴えられる可能性もあります）
ハッシュ値計算なら、Excelのマクロだけでもできます（「Excel ハッシュ　計算」で検索すると、一杯出てきます）のでトライして下さい。