用excel上網查音標又故障了，不知那裡出問題？

樓主熱帖

50 字節以內
不支持自定義 Discuz! 代碼

自我感覺良好

中學生 Rank: 2

帖子: 116
主題: 41
精華: 0
積分: 162
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-7-22
最後登錄: 2024-2-9

2^#

發表於 2015-5-29 22:21 | 顯示全部帖子

001.rar (26.24 KB) 只能回傳一些中譯…

50 字節以內
不支持自定義 Discuz! 代碼

TOP

自我感覺良好

中學生 Rank: 2

帖子: 116
主題: 41
精華: 0
積分: 162
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-7-22
最後登錄: 2024-2-9

3^#

發表於 2015-5-30 05:43 | 顯示全部帖子

回復 3# Hsieh
n = .responseText
                     If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
                     '摘取KK音標
                     If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
                     .Open "get", iurl2 & rng, False
                     .send
                     '從DICT.TW 英漢字典擷取字義
                     If InStr(.responseText, "</span><br />  ") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br />  ")(1), "<")(0)
                  End With
         End If
Next
End Sub

換個方法就可以用了…
真的太感謝了。

50 字節以內
不支持自定義 Discuz! 代碼

TOP

自我感覺良好

中學生 Rank: 2

帖子: 116
主題: 41
精華: 0
積分: 162
點名: 0
作業系統: XP
軟體版本: office2007
閱讀權限: 20
性別: 男
來自: Taiwan
註冊時間: 2010-7-22
最後登錄: 2024-2-9

4^#

發表於 2015-5-31 07:46 | 顯示全部帖子

回復 4# 自我感覺良好

亂改一通.rar (16.61 KB)

外行人把它改成這樣，程式應該還可以更簡易的

Sub searchIT(rng As Range)
Dim XH As Object
Dim shpRm As Shape
Columns("B:B").Select
With Selection.Font
      .Name = "Arial Unicode MS"
      .Size = 12
End With
Range("a1").Select
   Dim iurl, iurl2 As String
'清除已有的解釋及音標
iurl = "http://tw.dictionary.search.yahoo.com/search?p="
iurl2 = "http://dict.tw/index.pl?query="
For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("a50").End(xlUp))
         rng.Select
         If rng.Value <> "" Then
            rng.Select
            Set XH = CreateObject("Microsoft.XMLHTTP")
                  With XH
                     .Open "get", iurl & rng, False
                     .send
                     ' On Error Resume Next
                     '從Yahoo字典摘取第一組中文翻譯

                     If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
                     '摘取KK音標
                     If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
                     .Open "get", iurl2 & rng, False
                     .send
                     '從DICT.TW 英漢字典擷取字義
                     If InStr(.responseText, "</span><br />  ") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br />  ")(1), "<")(0)
                  End With
         End If
Next
End Sub

50 字節以內
不支持自定義 Discuz! 代碼

TOP