JANコードから医薬品コードサーチのサイトで医薬品名と規格単位・YJコードなどの情報を取得するExcelVBAコード

スポンサーリンク

医療用医薬品の一覧を取得するのは手間がかかる

医療用医薬品の業界は情報がきちんと整理されていないことが多く、必要な情報を取得するのに時間と手間がかかることが多いです。

私は医療用医薬品の原価管理・仕入管理などの仕事をしているのですが、ネットから情報を取得するのが面倒に感じることが多いです。

今回は私が仕事で使うために作った「JANコードから医薬品の規格単位や品名を取得するツール」をご紹介します。

(この記事は多くの人に使っていただけるツールというより、私が仕事のために作ったツールの備忘録としての意味が強いです。)

医療用医薬品の情報を記載されているサイト「医薬品コードサーチ」

医療用医薬品の情報を多く載せているサイトとして私がよく参考にしているのが、「医薬品コードサーチ」です。

無料で情報が取得できるサイトですので重宝するのですが、JANコードからの商品検索機能がないのが残念なところです。

今回私が紹介するツールではGoogle検索結果と医薬品コードサーチの情報を組み合わせることで、JANコードから医薬品名や規格単位などの情報を取得できるようにしています。

スポンサーリンク

医薬品情報を取得するExcelVBAサンプルコード

①医薬品の情報を他の包装単位含めてすべて取得するVBAコード

こちらのサンプルコードでは該当するJANコードの医薬品について他のJANコードの包装単位の情報含めすべて取得するものになります。
同じ医薬品でも複数のJANコードを持っているので、すべての情報を取得する際に役立ちます。

Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Sub JANコードから医薬品情報一覧取得()

Dim i As Long, k As Long
Dim IE As Object
Dim Doc As Object
Dim anchor As Object
Dim tag

Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True

i = 1
Do Until i > Cells(600000, 1).End(xlUp).Row

ループの最初:
tag = 0
IE.navigate (“https://www.google.co.jp/search?q=” & Cells(i, 1)) ’Google検索結果表示画面

Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1000
Loop
Sleep 2000

For Each anchor In IE.document.getelementsByTagName(“A”)
If InStr(anchor, “icode-search.com/index.php?”) > 0 Then
anchor.Click

Do While IE.Busy Or IE.readyState < READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 2000
tag = 1
Exit For

End If
Next

If tag <> 1 Then
i = i + 1
GoTo ループの最初
End If

Const 抽出列 = 1000
Set Doc = IE.document
On Error Resume Next
c = 抽出列 + 1
r = 1

For y = 1 To Doc.all.Length
If Doc.all(y).tagName = “TH” Or Doc.all(y).tagName = “TD” Then

c = c + 1
Cells(r, c) = Doc.all(y).innerText

ElseIf Doc.all(y).tagName = “TR” Then

r = r + 1
c = 抽出列 + 1

End If
Next y

y = 10
Dim s
s = 0

Do Until Cells(y, 抽出列 + 4) = “”
Cells(i + s, 3) = Cells(2, 抽出列 + 3)
Cells(i + s, 4) = Cells(6, 抽出列 + 3)
Cells(i + s, 5) = Cells(y, 抽出列 + 2)
Cells(i + s, 6) = Cells(y, 抽出列 + 3)
Cells(i + s, 7) = Cells(y, 抽出列 + 4)
Cells(i + s, 8) = Cells(y, 抽出列 + 5)

s = s + 1
Range(Cells(i + s, 1), Cells(i + s, 2)).Insert shift:=xlDown

y = y + 1
Loop
Range(Cells(i + s, 1), Cells(i + s, 2)).Delete shift:=xlUp

Range(Columns(抽出列), Columns(抽出列 + 10)).ClearContents

On Error GoTo 0

i = i + s
Loop

IE.Quit
Set IE = Nothing

End Sub

②調査対象のJANコードについてのみ情報を取得するサンプルコード

こちらはJANコードに紐づいた包装単位を取得するVBAコードになります。
一つの医薬品について1行表示になるので、余分な情報を考えなくてよくなる分続いての処理が楽になります。

Declare Sub Sleep Lib “kernel32” (ByVal dwMilliseconds As Long)

Sub JANコードから規格単位検索()

Dim i As Long, k As Long
Dim IE As Object
Dim Doc As Object
Dim anchor As Object
Dim tag

Set IE = CreateObject(“InternetExplorer.application”)
IE.Visible = True

i = Selection.Row

IE.navigate (“https://www.google.co.jp/search?q=” & Cells(i, 1)) ’Googleの検索結果を表示する

Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
DoEvents
Sleep 1000
Loop
Sleep 2000

For Each anchor In IE.document.getelementsByTagName(“A”)
If InStr(anchor, “icode-search.com/index.php?”) > 0 Then
anchor.Click

Do While IE.Busy Or IE.readyState < READYSTATE_COMPLETE
DoEvents
Sleep 1
Loop
Sleep 2000
tag = 1
Exit For

End If
Next

If tag <> 1 Then
IE.Quit
Exit Sub
MsgBox “該当なし”
End If

Set Doc = IE.document

For k = 1 To Doc.all.Length - 1
If Doc.all(k).innerText = Cells(i, 1).Text Then
Cells(i, 4) = Doc.all(k - 2).innerText
Exit For
End If
Next k

IE.Quit
Set IE = Nothing

End Sub

おすすめ書籍 amazonicon Amazon rakutenicon 楽天 Yahooicon Yahoo検索

コメント