法人番号を取得してくるマクロ

##企業名のばらつきを修正する
現在の顧客情報は、企業名そのものにも大きなばらつきがあって、社名が変更されたりするとお手上げになるし、企業ごとの売上の集計もできないのが現状でした
・○○コーポレーション
・○○・コーポレーション
の程度であれば良いのだが、
・○○商事株式会社
・○○商事営業部
・○○商事株式会社営業
・○○商事日本橋営業所
なんていうレベルである（実際はもっとすごい）。

##せっかくなので法人番号を取得して、それを一意のコードと結びつけようと考えた
http://www.houjin-bangou.nta.go.jp/
＊法人番号の利用開始については、法人番号システムのWeb‐API機能をビジネス活用しよう（申請編）を参考にさせていただきましたありがとうございます

で、前に使っていた「郵便番号から住所を取得するマクロ」をベースにして作ってみたのがこちら(idのところはｘに置換してます)

法人番号取得.vba

Option Explicit

Sub run()
'---------------------------------------
Dim CorpName As String
Dim i As Long
Dim arr As Variant
For i = 2 To ThisWorkbook.Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
CorpName = Cells(i, 2)
On Error Resume Next
arr = CorpCode(URL_Encode(CorpName))

Cells(i, 4) = arr(4)
Cells(i, 5) = arr(9)
Cells(i, 6) = arr(12)
Cells(i, 7) = arr(13)
Cells(i, 8) = arr(14)　
 
Next i
End Sub

データを持ってくる関数.vba

Function CorpCode(CorpName As String) As String()
Dim objXMLHttp As Object
Dim tmp
Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
    objXMLHttp.Open "GET", "https://api.houjin-bangou.nta.go.jp/2/name?id=xxxxxxxxxxxxxxx&type=02&mode=2&name=" & CorpName, False
    objXMLHttp.Send

    tmp = Split(Replace(objXMLHttp.responseText, """", ""), ",")
    CorpCode = tmp
'---------------------------------------
End Function

UTF-8にエンコードする関数.vba

Function URL_Encode(ByVal strOrg As String) As String
  With CreateObject("ScriptControl")
    .Language = "JScript"
    URL_Encode = .CodeObject.encodeURI(strOrg)
  End With
End Function

ExcelはShift-JISでデータを持っているので、URL-Encode関数に放り込んで、jScriptで企業名をUTF-8にエンコードしています
UTF-8じゃないとURLはエラーになってしまうのを防ぎます
CorpCode関数内でGETリクエストを生成してCSVの配列として戻り値を得て、そこから欲しいデータ

4=法人番号
5=法人名
12=都道府県
13=市区町村
14=以下の住所

をセルに展開しています。
Corei3、4GBメモリ、Excel2013の環境で200件が3分くらいのペースでした

##課題
・部分一致でデータを拾っているので、似たような社名だと最初に引っかかった企業名になる
複数のレスポンスがあるはずなのでそこから住所などで更に絞り込む。という方法も考えたのですが、弊社の場合は営業所などで受注していることもあるため、うまくいかないだろうと考えました。法人番号を引けなかったものを含めて、目でチェックする必要性は消えないので、ここは手動で行うことにしました