用excel上網查音標 又掛了

自我感覺良好

真害YAHOO!奇摩字典又改版了
音標又找不到了
只能看到解釋
新增的即時發音好像粉不錯
    1. Sub searchIT(Rng As Range)
   2.     Dim XH As Object
   3.     Dim shpRm As Shape
   4.     '清除已有的解釋及音標
   5.     With Rng.EntireRow
   6.         .Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
   7.     End With
   8.     '開啟網頁
   9.     Set XH = CreateObject("Microsoft.XMLHTTP")
  10.     With XH
  11.         .Open "get", "http://tw.dictionary.yahoo.com/dictionary?p=" & Rng.Text, False
  12.         .send
  13.         On Error Resume Next
  14.         '摘取第一組中文翻譯
  15.         Rng.Offset(0, 2) = Split(Split(.responseText, "class=""description""><p>1.")(1), "<")(0)
  16.         '摘取KK音標
  17.         Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span>  ")(1), InStr(VBA.Split(.responseText, "KK</span>  ")(1), "]"))
  18.         
  19.     End With
  20.     Rng.Select
  21. End Sub

GBKEE

回復 1# 自我感覺良好
17. Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span>  ")(1), InStr(VBA.Split(.responseText, "KK</span>  ")(1), "]"))
刪除空格修改如下:
Rng.Offset(0, 1) = Left(VBA.Split(.responseText, "KK</span>")(1), InStr(VBA.Split(.responseText, "KK</span>")(1), "]"))

oobird

'摘取KK音標
           Rng.Offset(0, 1) = Split(Split(.responseText, "KK</span> ")(1), "<span> DJ")(0)

HSIEN6001

回復 3# oobird
請問版大
我用了相關語法.responseText
可是電腦出現不正確的引用

可否幫我看看問題,謝謝!
測試.rar (4.8 KB)

下載次數: 15

2012-6-19 16:12

oobird

1. Sub URLString()
   
2. Dim x As String
   
3.     Set xPost = CreateObject("Microsoft.XMLHTTP")
   
4.     Set Fsys = CreateObject("Scripting.FileSystemObject")
   
5. With xPost
   
6.     .Open "GET", "http://mops.twse.com.tw/mops/web/ajax_t108sb27?step=1&firstin=ture&off=1&TYPEK=sii&co_id_1=&co_id_2=&year=101&month=&b_date=&e_date=&type=1&rulesubmit2=%20%E6%90%9C%E5%B0%8B%20", 0   '要擷取原始碼的網址
   
7.     .send
   
8.     Do While xPost.ReadyState <> 4
   
9.     Loop
   
10. 
    
11.    
    
12. 'PS:此處符合搜尋的字串有兩組,語法請教..... x = 傳回 "t108sb27_" 開始到 ".csv" 結束的字串
    
13.    
    
14.     x = Split(Split(.responseText, "filename' value='")(1), "<table class='noBorder")(0)
    
15. End With
    
16. End Sub

複製代碼

回復 4# HSIEN6001

HSIEN6001

回復 5# oobird


    oobird 大
回傳值,多了 '> 及強制換行Alt+Enter
可否排除?!

剛剛對照一下語法
仍舊不解 .responseText
在之前未何會出現"不正確的引用"
兩者VBA 除了回圈
似乎差異不大

我外行,請大大提示
謝謝!

HSIEN6001

回復 5# oobird

剛剛稍微修改試了GBKEE大的語法
排除了Alt+Enter的問題

Left(VBA.Split(.responseText, "filename' value='")(1), InStr(VBA.Split(.responseText, "<table class='noBorder")(1), ">"))

算是"瞎貓"~呼弄對了嗎?!
^^

另一個疑問,還請版大開示!

Hsieh

回復 6# HSIEN6001
.responseText必須在With xPost.....End With敘述區段內引用

HSIEN6001

回復 8# Hsieh


    我VBA是在ㄧ知半解的應用 http://tw.knowledge.yahoo.com/question/question?qid=1512022306295
所以常常搞不清楚
謝謝版大提醒,感恩!

HSIEN6001

回復 2# GBKEE

請問 <input type='hidden' name='filename' value='t108sb27_20120712_17145551.csv'>
取出這段 t108sb27_20120712_17145551.csv
應該怎麼下語法才對

以下語法,有時會Err
Left(VBA.Split(.responseText, "filename' value='")(1), InStr(VBA.Split(.responseText, "<table class='noBorder")(1), ">"))
Left(VBA.Split(.responseText, "filename' value='")(1), InStr(VBA.Split(.responseText, "<table class='noBorder")(1), "<"))
紅色字體位置,時常要更正
是長度運算錯誤?!

這段語法不懂,可以麻煩指導及稍加說明?!
Left(VBA.Split(.responseText, "filename' value='")(1), InStr(VBA.Split(.responseText, "<table class='noBorder")(1), ">"))
InStr 及 Split 查過了還是不懂

~謝謝!!