excel での英和

質問

今、A列に英単語を100個ほど羅列したものがあるのですが、
B列にそれぞれ対応したネット上の辞典での意味を自動的に入れるにはどうしたらいいですか？
こんなことってexcelで可能ですか？

回答No.7

mitarashi

#2です。スレをお借りして．．．
Wendy02様
フォローありがとうございました。参考にさせていただきます。
当方の「後学のためにやってみた」レベルから、実用的なものに昇華して質問者様のお役にもたつと存じます。

回答No.6

Wendy02

'--前回からの続き
Private Function CutHMLCode(strTxt As String)
　Dim ar As Variant
　Dim buf As String, a As String, b As String, tmp As String
　Dim i As Long, j As Long, flg As Boolean
　If InStr(1, strTxt, "検索結果は0件でした。", 1) > 0 Then
　　CutHMLCode = "Not Found"
　　Exit Function
　End If
　i = InStr(1, strTxt, "<div id=""spoLine"">", 1)
　If i > 0 Then
　　tmp = Mid(strTxt, 1, i - 1)
　　ar = Split(tmp, "<div class=""prog_block"">", , 1)
　　flg = True
　Else
　　j = InStr(1, strTxt, "<dl class=""allList"">", 1)
　　 On Error Resume Next
　　ar = Split(strTxt, "<dd>", , 1)
　End If
　With CreateObject("VBScript.RegExp")
　　.Pattern = "<[^>]+>"
　　.Global = True
　　For i = 1 To UBound(ar)
　　　j = InStr(1, ar(i), "[", 1)
　　　If j > 0 And flg Then
　　　　b = Mid(ar(i), j, InStr(j, ar(i), vbCrLf, 0) - j)
　　　　b = .Replace(b, "")
　　　　If b Like "[[].[]]" Then
　　　　　a = a & " " & .Replace(b, "")
　　　　Else
　　　　　a = a & " " & .Replace(b, "")
　　　　End If
　　　Else
　　　　 a = a & " " & .Replace(ar(i), "")
　　　End If
　　Next
　End With
　a = Replace(a, vbCr, " "):　a = Replace(a, vbLf, " ")
　i = InStr(1, a, Space(10), 1): If i > 0 Then a = Mid(a, 1, i)
　i = InStr(1, a, "&nbsp", 1): If i > 0 Then a = Mid(a, 1, i)
　CutHMLCode = a
End Function

●このマクロの注意点
・合計70数回で、Goo辞書にアクセスすると、サーバーが拒否するようです。403:Forbidden が返ります。マクロを遅くしても、変わらないはずです。SetRequestHeader 等を変えれば動きますが、あまり、そのようなことはお勧めしません。時間が経てば復帰します。良いところがあれば、そちらのほうがよいです。ただし、マクロの内容も変えなくてはなりません。

・このマクロには、元の単語のスペルチェックはしていません。最初に書いたコードには、スペルチェック機能を付けましたが、今回はついていません。事前にスペルチェックをしていただいたほうがよいです。また、、
url = sURL & c.Value & "&kind=ej&mode=1&kwassist=0"
ここのmode =1 をお勧めします。見つからない場合は、["Not Found"] が返ります。
mode =0を指定すると、関連のものも出てきます。

・本来は、アクセスのたびごとに、oHttp のオブジェクトを空にするほうが、トラブルが少ないような気がしますが、今回は、その方法はやめました。

回答No.5

Wendy02

スレを再びお借りします。#4の返事です。
mitarashiさん、返事ありがとうございます。本当は、回答者どうしで、作り上げるということが、理想なんですけれども……。

ファイヤーウォールの件は、いつも、メッセージを出すようにしていましたので、唐突にエラーを出すという経験はありませんでしたから、私はトンチンカンな反応をしてしまいました。VBAでは、サーバーの状態を監視させるようにしています。

>もっと確実な方法があれば、御開示いただけると幸いです。
確実とは言えませんが、一応、mitarashiさんのコードを参考にして新たに書いてみました。どう書いても、2000字の枠は越えてしまうようです。細かいところまでは、まだ見切れていません。今年のGoo改編から、ずっと、ログ取得ようのコードをメインテしています。

Sub GetDic2Cell()
　Const sURL As String = "http://dictionary.goo.ne.jp/search.php?MT="
　Dim oHttp As Object
　Dim url As String, buf As String
　Dim ini As Long, iend As Long
　Dim c As Range
　On Error GoTo ErrHandler
　'Set oHttp = CreateObject("Microsoft.XMLHTTP")
　Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
　'Application.ScreenUpdating = False 'そのままのほうが良いかも。
　With oHttp
　　For Each c In Range("A1", Cells(Rows.Count, 1).End(xlUp))
　　　If c.Value <> "" And c.Offset(, 1).Value = "" Then
　　　　url = sURL & c.Value & "&kind=ej&mode=1&kwassist=0" 'mode=0 (vague),1(strict)
　　　　.Open "GET", url, False
　　　　'.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 5.0; en-JA; rv:1.9.2.11)"
　　　　.SetRequestHeader "User-Agent", "Mozilla/5.1 (Windows; U; Windows NT 5.0; en-JA; rv:1.9.2.13)"
　　　　.Send
　　　　If .status = 200 Then
　　　　　buf = .ResponseText
　　　　　buf = CutHMLCode(buf)
　　　　　buf = Replace(buf, "；", Space(2), , , 1)
　　　　　c.Offset(, 1).Value = buf
　　　　　c.Offset(, 1).WrapText = False
　　　　Else
　　　　　MsgBox .status & " : " & .statusText
　　　　　Exit For
　　　　End If
　　　End If
　　Next
　End With
　'Application.ScreenUpdating = True
ErrHandler:
　Set oHttp = Nothing
　If Err.Number > 0 Then
　　MsgBox Err.Number & "; " & Err.Description
　End If
End Sub
'--次回に続く

回答No.4

mitarashi

#2です。余談に走ってしまって申し訳ないですが、ウィルスセキュリティのファイアウォールのお節介について補足しておきます。
以前にhttp://okwave.jp/qa/q6136980.htmlで、Wendy02さんが書かれたIf oHttpReq.status = 200 Thenによるリンク切れ判断をやった事があります。
今回の回答のシンプルなコードでエラーになったため、相当悩んだ末に、当時のコードを走らせてみたところやはりエラーが発生し、これはおかしいという事になったものです。
今回発生したエラーは、「-2146697211 指定されたリソースはみつかりません」というものでした。
ファイアウォールで、エクセルからの通信を許可し、かつエクセルを再度立ち上げないと、通信してくれませんでした。
なお、エクセルからの通信遮断は、いつかの更新の際にウィルスセキュリティが勝手に変更したものと思います。

>"apprehension" という単語が取れません。
を確認いたしましたが、htmlの構造が全く違っていますね。XMLのような任意につけた？タグがありますし。
gooさんのデータのバリエーションがどれだけあるか分かりませんので、Wendy02さんのもっと確実な方法があれば、御開示いただけると幸いです。

回答No.3

Wendy02

>これではfirefoxで検索結果を表示するのみで、セルに入力できていません。

#1さんの参照先のコードは、もしかしたら設定で解除できるかもしれませんが、こちらの設定のままでは、IEは、そのままでは間違いなくハングしますから、理解せずには使わないほうがよいです。Hyperlinkですから、ブラウザを選ぶわけではありません。しかし、本来は、IE Window を取得するか、IEオートメーションを生成して、そのオブジェクトに、その都度、Quit するなりすればよいのですが、それでは効率が悪いです。ただ、分かる人なら分かりますが、FireFox で検索結果を表示するのみ、なんていうことではありません。そのようなコードが書けるなら、もう少し、違うコードになっているはずです。

ただ、実際問題として、そのGooの辞書を丸々貼り付けると、単語の意味だけではないので、上手くいかないような気がします。私は、PDICの英辞郎から抜き出す作業を、年に1回していますので、良く知っています。リストから選ぶことも大変です。私は、一回、1,000語を抜き出すのですが、なかなか大変な作業です。

後は、質問主さんには予めお詫びしますが、ちょっとスレをお借りして、mitarashiさん宛にさせていただきます。

mitarashiさんが、回答していますので、こちらから同じようなコードを書くことは遠慮しておくというか、私が書いたら、2,000字を越えてしまいました。

>ウィルスセキュリティがいつの間にかエクセルからの通信を遮断してくれていて悩みました。

　　oHttpReq.Send
　　If oHttpReq.status = 200 Then 'と加えたらどうでしょうか。
で、戻り値を見ていたら、問題が発生しても解除出来ると思います。ファイヤーウォールでシャツトアウトするなら、セキュリティソフトから、メッセージが出ないでしょうか？どこを使っているかは確認したことがありません。Gooのサーバーから、403=Forbiddenが返ることが多いようですが。

それと、私の持っている単語リストから、#2のコードを試してみると、例えば、"apprehension" という単語が取れません。他、これらの単語が取れません。
(respite, rationale, rebuff, rectitude, flagship, rapport, renegade, hypertension, upbringing)

それは、div class="prog_block"を探してやればよいと思います。たぶん、お分かりになると思います。

回答No.2

mitarashi

#1を参考にさせていただきました。
'Microsoft XML v3.0に参照設定要
'もっと新しい版がありますが、Microsoft XML v3.0のSDKのヘルプの参考コードを改造したため
'DOMで操作出来ないかと思ったがうまくいっていません。
'注）ウィルスセキュリティがいつの間にかエクセルからの通信を遮断してくれていて悩みました。ご参考まで。
Sub test()
Dim oHttpReq As New XMLHTTP30
Dim url As String, buf As String
Dim startPos As Long, endPos As Long
Dim myRange As Range

For Each myRange In Range(Range("A1"), Range("A" & Rows.Count).End(xlUp)).Cells
url = "http://dictionary.goo.ne.jp/search.php?MT=" & myRange.Value & "&kind=ej&mode=0&kwassist=0"
oHttpReq.Open "GET", url, False
oHttpReq.Send
buf = oHttpReq.ResponseText
startPos = InStr(buf, "<dl class=""allList"">")
If startPos > 0 Then
startPos = InStr(startPos, buf, "<dd>")
endPos = InStr(startPos, buf, "</dd>")
myRange.Offset(0, 1).Value = Mid(buf, startPos + 4, endPos - startPos - 4)
End If
Next myRange
Set oHttpReq = Nothing
End Sub

お正月の読み物にどうぞ。
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsVbaXMLHTTP.html

回答No.1

noname#154242

さんこうに
●エクセルVBAについて質問です。 A列に複数の英単語があるとしま.. - 人力検索はてな
http://q.hatena.ne.jp/1191271716

補足

これではfirefoxで検索結果を表示するのみで、セルに入力できていません。