- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
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)
-
-
E.png
(18.87 KB)
|
發表於 2011-11-21 10:02
| 
