Hsieh

¦^´_ 2# ¦Û§Ú·Pı¨}¦n

1. Sub Macro1()
   
2. '
   
3. ' Macro1 Macro
   
4. '
   
5. ' §Ö³tÁä: Ctrl+p
   
6. 
   
7.     Columns("B:B").Select
   
8.     With Selection.Font
   
9.         .Name = "Arial Unicode MS"
   
10.         .Size = 12
    
11.     End With
    
12. Range("a1").Select
    
13. 
    
14. Dim XH As Object
    
15. 
    
16.     Dim rng As Range
    
17.    
    
18.       Dim iurl, iurl2 As String
    
19.     '²M°£¤w¦³ªº¸ÑÄÀ¤Î­µ¼Ð
    
20.     iurl = "http://tw.dictionary.search.yahoo.com/search?p="
    
21.     iurl2 = "http://dict.tw/index.pl?query="
    
22.     For Each rng In ActiveSheet.Range("a1", ActiveSheet.Range("a65536").End(xlUp))
    
23.             rng.Select
    
24.             If rng.Value <> "" Then
    
25.               rng.Select
    
26.               Set XH = CreateObject("Microsoft.XMLHTTP")
    
27.                     With XH
    
28.                         .Open "get", iurl & rng, False
    
29.                         .send
    
30.                         ' On Error Resume Next
    
31.                         '±qYahoo¦r¨åºK¨ú²Ä¤@²Õ¤¤¤å½Ķ
    
32.                         n = .responseText
    
33.                          If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
    
34.                         'ºK¨úKK­µ¼Ð
    
35.                         If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
    
36.                         .Open "get", iurl2 & rng, False
    
37.                         .send
    
38.                         '±qDICT.TW ­^º~¦r¨åÂ^¨ú¦r¸q
    
39.                         If InStr(.responseText, "</span><br /> &nbsp;") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
    
40.                     End With
    
41.              End If
    
42.     Next
    
43. End Sub

½Æ»s¥N½X