12
返回列表 上一主題 發帖

用excel上網查音標 又掛了

自我感覺良好

帖子
117 
主題
42 
精華
0 
積分
164 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-7-22 
最後登錄
2025-7-22 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-11-30 07:30 | 只看該作者

用excel上網查音標 又掛了

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

001.JPG (140.33 KB)

001.JPG

收藏 分享
50 字節以內
不支持自定義 Discuz! 代碼

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
2#
發表於 2012-11-30 14:16 | 只看該作者
123.gif
  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
複製代碼
50 字節以內
不支持自定義 Discuz! 代碼

TOP

自我感覺良好

帖子
117 
主題
42 
精華
0 
積分
164 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-7-22 
最後登錄
2025-7-22 
3#
發表於 2012-11-30 15:59 | 只看該作者
奇怪呢!還是不能用.....

002.JPG (117.05 KB)

002.JPG

003.JPG (98.75 KB)

003.JPG

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

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
4#
發表於 2012-11-30 23:47 | 只看該作者
我自己回家用ie9 上面的程式也不行...
把網址改一下就好了.....
  1.                      .Open "get", "http://tw.dictionary.search.yahoo.com/search?p=" & Rng, False
複製代碼
上網抓音標.rar (9.42 KB)
50 字節以內
不支持自定義 Discuz! 代碼

TOP

自我感覺良好

帖子
117 
主題
42 
精華
0 
積分
164 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-7-22 
最後登錄
2025-7-22 
5#
發表於 2012-12-1 06:21 | 只看該作者
查字001.rar (19 KB)
我還是小朋友無法下載檔案
附上檔案幫我看看那裡出錯了
我查單字都會出現
<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]
50 字節以內
不支持自定義 Discuz! 代碼

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
6#
發表於 2012-12-1 08:56 | 只看該作者
回復 5# 自我感覺良好

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

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

TOP

自我感覺良好

帖子
117 
主題
42 
精華
0 
積分
164 
點名
0  
作業系統
XP 
軟體版本
office2007 
閱讀權限
20 
性別
男 
來自
Taiwan 
註冊時間
2010-7-22 
最後登錄
2025-7-22 
7#
發表於 2012-12-1 09:38 | 只看該作者
感恩!太感謝了。
只是不知那一天
yahoo又要開偶的玩笑……
50 字節以內
不支持自定義 Discuz! 代碼

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
8#
發表於 2012-12-1 10:25 | 只看該作者
感恩!太感謝了。
只是不知那一天
yahoo又要開偶的玩笑……
自我感覺良好 發表於 2012-12-1 09:38



哈哈 老實跟你說 我也不懂程式語法 無中生有是不行....
不過遇到有興趣的   就土法煉鋼給他練...多嘗試就出來..別怕遇到困難....享受解決問題的樂趣囉.
50 字節以內
不支持自定義 Discuz! 代碼

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
9#
發表於 2012-12-1 11:14 | 只看該作者
  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


  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)
download it
50 字節以內
不支持自定義 Discuz! 代碼

TOP

softsadwind

帖子
129 
主題
3 
精華
0 
積分
178 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2018-11-10 
10#
發表於 2012-12-1 16:58 | 只看該作者
哈哈 我又來了
反正作自己有興趣的事情囉


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

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
12
返回列表 上一主題