用excel上網查音標 又掛了

自我感覺良好

用excel上網查音標 又掛了
可能網頁改變…
查不出原因
煩請各位大大幫幫忙

softsadwind

下載 (11.89 KB)

2012-11-30 14:16

1. Private Sub CommandButton1_Click()
   
2.   Dim XH As Object
   
3.   Dim shpRm As Shape
   
4. ' With Rng.EntireRow
   
5.   '          .Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
   
6.   'End With
   
7.   Dim i
   
8.     With Range(Range("A1"), Range("A1").End(xlDown))
   
9.         For i = .Columns(1).Rows.Count To 2 Step -1
   
10.             If .Cells(i, 1).Value <> "" Then
    
11.                 Set Rng = Cells(i, 1)
    
12.                 Set XH = CreateObject("Microsoft.XMLHTTP")
    
13.                 With XH
    
14.                      .Open "get", "http://tw.dictionary.yahoo.com/dictionary?p=" & Rng.Text, False
    
15.                      .send
    
16.                      On Error Resume Next
    
17.                      Rng.Offset(0, 2) = Split(Split(.responseText, "class=""description""><p>1.<span class=""proun_value"">")(1), "<")(0)
    
18.                      Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span><span class=""proun_value"">")(1), InStr(VBA.Split(.responseText, "KK</span><span class=""proun_value"">")(1), "]"))
    
19.                 End With
    
20.             Else
    
21.             End If
    
22.             Next
    
23.    End With
    
24. End Sub

複製代碼

自我感覺良好

奇怪呢!還是不能用.....

softsadwind

我自己回家用ie9 上面的程式也不行...
把網址改一下就好了.....

1.                      .Open "get", "http://tw.dictionary.search.yahoo.com/search?p=" & Rng, False

複製代碼

上網抓音標.rar (9.42 KB)

下載次數: 14

2012-11-30 23:45

自我感覺良好

查字001.rar (19 KB)

下載次數: 3

2012-12-1 06:16

我還是小朋友無法下載檔案
附上檔案幫我看看那裡出錯了
我查單字都會出現
<span class="proun_value">:Q

often        <span class="proun_value">[ˋɔfən]
public        <span class="proun_value">[ˋpʌblɪk]
airport        <span class="proun_value">[ˋɛr͵port]
       
       
airplane        <span class="proun_value">[ˋɛr͵plen]
system        <span class="proun_value">[ˋsɪstəm]
protect        <span class="proun_value">[prəˋtɛkt]

softsadwind

回復 5# 自我感覺良好

    去下載囉
    https://www.dropbox.com/s/lxz2rycl53ax2cc/%E6%9F%A5%E5%AD%97001.xlsm

   

下載 (74.92 KB)

2012-12-1 08:56

自我感覺良好

下載 (139.83 KB)

2012-12-1 09:34

感恩!太感謝了。
只是不知那一天
yahoo又要開偶的玩笑……

softsadwind

感恩!太感謝了。
只是不知那一天
yahoo又要開偶的玩笑……
自我感覺良好 發表於 2012-12-1 09:38

哈哈 老實跟你說 我也不懂程式語法 無中生有是不行....
不過遇到有興趣的   就土法煉鋼給他練...多嘗試就出來..別怕遇到困難....享受解決問題的樂趣囉.

softsadwind

1. Sub searchIT(Rng As Range)
   
2.     Dim XH As Object
   
3.     Dim shpRm As Shape
   
4.     Dim iurl, iurl2 As String
   
5.     '清除已有的解釋及音標
   
6.     iurl = "http://tw.dictionary.search.yahoo.com/search?p="
   
7.     iurl2 = "http://dict.tw/index.pl?query="
   
8.     With Rng.EntireRow
   
9.         .Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
   
10.     End With
    
11.     '開啟網頁
    
12.     Set XH = CreateObject("Microsoft.XMLHTTP")
    
13.     With XH
    
14. 
    
15. 
    
16.         .Open "get", iurl & Rng, False
    
17.       
    
18.         
    
19.         .send
    
20.         On Error Resume Next
    
21.         '從Yahoo字典摘取第一組中文翻譯
    
22.         'Rng.Offset(0, 2) = Split(Split(.responseText, "<ol class=""explanation_ol""><li ><p class=""explanation"">")(1), "<")(0)
    
23.         Rng.Offset(0, 2) = Split(Split(.responseText, "<p class=""explanation"">")(1), "<")(0)
    
24.         '摘取KK音標
    
25.         'Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span><span class=""proun_value"">")(1), InStr(VBA.Split(.responseText, "KK</span><span class=""proun_value"">")(1), "]"))
    
26.          Rng.Offset(0, 1) = Left(VBA.Split(.responseText, """proun_value"">")(1), InStr(VBA.Split(.responseText, """proun_value"">")(1), "]"))
    
27.         .Open "get", iurl2 & Rng, False
    
28.         .send
    
29.         '從DICT.TW 英漢字典擷取字義
    
30.         Rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
    
31.         
    
32.     End With
    
33.    
    
34. End Sub

複製代碼

查字001.rar (25.32 KB)

下載次數: 7

2012-12-1 11:12

download it

下載 (297.42 KB)

2012-12-1 11:12

softsadwind

哈哈 我又來了
反正作自己有興趣的事情囉

下載 (183.24 KB)

2012-12-1 16:58

查字典02