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


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

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

回答の条件
  • 1人3回まで
  • 13歳以上
  • 登録:2012/03/04 10:49:33
  • 終了:2012/03/04 12:48:47

ベストアンサー

id:windofjuly No.1

うぃんど回答回数2625ベストアンサー獲得回数11492012/03/04 12:05:23

ポイント300pt

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

なお、
プログラムで集中的にアクセスすると、他の利用者に迷惑なだけでなく、
サイトに対する攻撃とみなされ警察が動く事態になる場合もありますので、
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
他6件のコメントを見る
id:windofjuly

>/span>を含めて調べる必要がある

ちがいます
spanは人力検索のバグで、私の返信に無用に追加されてしまったものです・・・orz

調べるのはejje.weblio.jpの検索結果ページのソースコードで、
div class=Jstkg や div class=Neens が含まれている部分と、
それぞれに続く数行の部分です

2012/03/04 13:18:50
id:mutamutamuta

納得です。

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

2012/03/04 17:49:34

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません