用excel上網查音標

11^# 跳轉到 »

發表於 2016-1-26 10:16 | 只看該作者

我也是一樣的問題卡在send,請問如何處理

12^#

發表於 2016-1-26 13:40 | 只看該作者

本帖最後由 c_c_lai 於 2016-1-26 13:41 編輯

回復 1# 自我感覺良好
回復 2# Hsieh
回復 6# GBKEE

Option Explicit
Sub searchIT(Rng As Range)
Dim XH As Object
Dim shpRm As Shape
' 清除已有的解釋及音標
With Rng.EntireRow
.Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
End With
' 開啟網頁
Set XH = CreateObject("Microsoft.XMLHTTP")
With XH
.Open "get", "http://tw.dictionary.search.yahoo.com/search?p=" & Rng.Text, False
.send
On Error Resume Next
' 摘取第一組中文翻譯
' Rng.Offset(0, 2) = Split(Split(.responseText, "class=""description""><p>1.")(1), "<")(0)
If InStr(.responseText, "><h4>1.") > 0 Then Rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
' 摘取KK音標
' Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span> ")(1), InStr(VBA.Split(.responseText, "KK</span> ")(1), "]"))
' Rng.Offset(0, 1) = Split((Split(.responseText, "KK</span>")(1)), "<span>")(0)
If InStr(.responseText, ">KK[") > 0 Then Rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
End With
Rng.Select
End Sub
Sub Ex()
Dim Rng As Range
For Each Rng In ActiveSheet.Range("A1", ActiveSheet.Range("A" & Rows.Count).End(xlUp))
Rng.Select
If Rng.Value <> "" Then
searchIT Rng
End If
Next
End Sub

複製代碼

E.png (18.87 KB)

靜思自在 : 改變自己是自救，影響別人是救人。