人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile


Excelのリストから、ExcelVBAを用いて、IEで一括検索がしたいです。
どのようなコードになるかお教えいただけないでしょうか?


具体的には、以下の手順を繰り返したいです。
・ExcelのA列に英単語が数百行ほど埋まっている
・A列の単語に対応する和訳を隣のB列にA列行数分だけ出力したい
(http://ejje.weblio.jp/でA列の単語を検索した結果、画面内『日英・英日専門用語辞書』の和訳部分が欲しい)


当方のレベルは、VBAのコードを時間をかければ読むことができる程度です。
今後このような作業が何度か発生しそうな状態で考えあぐねていました。
何卒よろしくお願いします。

●質問者: mutamutamuta
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● うぃんど
●300ポイント ベストアンサー

なるべくシンプルに作ってみた例

なお、
プログラムで集中的にアクセスすると、他の利用者に迷惑なだけでなく、
サイトに対する攻撃とみなされ警察が動く事態になる場合もありますので、
3秒(3000ミリ秒)に1回ずつアクセスするようにしてあります

Option Explicit

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub main()
  ' 開始位置
 Worksheets("Sheet1").Select
 Range("A1").Select
  ' 空白になるまでループ
 Do While Selection.Text <> ""
  ' 1つ右のセルに関数の結果を代入
 Selection.Offset(0, 1).Value = getWeblio(Selection.Text)
  ' 1つ下のセルに移動
 Selection.Offset(1, 0).Select
  ' 実行間隔の調整
 Sleep (3000)
 Loop
End Sub

Function getWeblio(keyword As String) As String
  ' http://ejje.weblio.jp から情報を得るための関数
 Dim URL As String
 Dim XML As Object
 Dim RegExp As Object
 Dim ps, pe As Long
 Dim text1 As String
 Dim text2 As String
 
  ' WEBサイトにアクセス
 URL = "http://ejje.weblio.jp/content/" & keyword
 
 Set XML = CreateObject("MSXML2.XMLHTTP")
 XML.Open "GET", URL, False
 XML.Send
 text1 = XML.responseText
 
  ' 大雑把な抜き出し
 ps = InStr(text1, "www.cjk.org")
 If ps = 0 Then
 getWeblio = "*": '該当無しか、トラブル発生のいずれかの場合は*にしました
 Exit Function
 End If
 
 ps = InStr(ps, text1, "<div class=Neens>")
 pe = InStr(ps, text1, "</div>")
 text2 = Mid(text1, ps, pe - ps)
 
  ' タグ削除と整形
 Set RegExp = CreateObject("VBScript.RegExp")
 With RegExp
 .Pattern = "<.+?>"
 .IgnoreCase = True
 .Global = True
 text2 = .Replace(text2, "")
 .Pattern = "^\n(.+)\n$"
 text2 = .Replace(text2, "$1")
 End With
 
  ' 結果を返す
 getWeblio = text2
End Function

うぃんどさんのコメント
回答を編集して、前後の無駄な改行を削るコードを追加しました >|vb| .Pattern = "^\n(.+)\n$" text2 = .Replace(text2, "$1") ||<

mutamutamutaさんのコメント
早速のご回答ありがとうございます。 後ほどベストアンサーとさせていただきます。 使用して気づいたのが・・ 検索語がJST辞書の方が結果が得られる事でした(汗 画面内『日英・英日専門用語辞書』→『JST科学技術用語日英対訳辞書』の 検索結果が欲しい場合、以下の部分を「Jstkg」へ変更する以外、どの部分を変更すると結果が得られるでしょうか? もうポイントは加算されないのですが、もしよろしければご教示願います。 ps = InStr(ps, text1, "<div class=Jstkg>")

うぃんどさんのコメント
再度調べてみると「大雑把な抜き出し」部分は、 二段階にしなくてもよく、さらに簡単になりました 下記は「JST科学技術用語日英対訳辞書」向けにしてあります コメントのほうは「日英・英日専門用語辞書」の場合です 他の辞書も同様の構造になっている様なので、 ソースコードを見て調整すると良いでしょう >|vb| ' 大雑把な抜き出し ' ps = InStr(ps, text1, "<div class=Neens>") ps = InStr(text1, "<div class=Jstkg>") If ps = 0 Then getWeblio = "*": '該当無しか、トラブル発生のいずれかの場合は*にしました Exit Function End If pe = InStr(ps, text1, "</div>") text2 = Mid(text1, ps, pe - ps) ||<

うぃんどさんのコメント
コード貼りなおし >|| ' 大雑把な抜き出し ' ps = InStr(ps,text1,"<div class=Neens>") ps = InStr(text1,/span> "<div class=Jstkg>") If ps = 0 Then getWeblio = "*":span class="synComment"> '該当無しか、トラブル発生のいずれかの場合は*にしました Exit Function End If pe = InStr(ps,/span> text1,/span> "</div>") text2 = Mid(text1,/span> ps,/span> pe - ps) ||<

うぃんどさんのコメント
コメントが、なんだかおかしいのですが、同じものを貼り付けてますので、 おかしな部分を削除して読み替えてください

mutamutamutaさんのコメント
バッチリ動きました! 取得した文字列内から必要な部分を抽出するために、 /span>を含めて調べる必要があるんですね。ソースで違いを確認してみます。 迅速なご対応で、とても助かりました。 ありがとうございました。

うぃんどさんのコメント
>/span>を含めて調べる必要がある ちがいます spanは人力検索のバグで、私の返信に無用に追加されてしまったものです・・・orz 調べるのはejje.weblio.jpの検索結果ページのソースコードで、 div class=Jstkg や div class=Neens が含まれている部分と、 それぞれに続く数行の部分です

mutamutamutaさんのコメント
納得です。 /span>は検索結果ページのソースコードの該当箇所には含まれていませんね。。 おかげさまで、あっという間に和訳が終わりそうです。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ