¥Îexcel¤Wºô¬d­µ¼Ð¤S¬G»Ù¤F¡A¤£ª¾¨º¸Ì¥X°ÝÃD¡H

¦Û§Ú·Pı¨}¦n

¤U¸ü (80.49 KB)

2015-5-28 06:34

¦Û§Ú·Pı¨}¦n

001.rar (26.24 KB)

¤U¸ü¦¸¼Æ: 7

2015-5-29 22:20

¥u¯à¦^¶Ç¤@¨Ç¤¤Ä¶¡K

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

¦Û§Ú·Pı¨}¦n

¦^´_ 3# Hsieh
n = .responseText
                         If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
                        'ºK¨úKK­µ¼Ð
                        If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
                        .Open "get", iurl2 & rng, False
                        .send
                        '±qDICT.TW ­^º~¦r¨åÂ^¨ú¦r¸q
                        If InStr(.responseText, "</span><br /> &nbsp;") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
                    End With
             End If
    Next
End Sub


´«­Ó¤èªk´N¥i¥H¥Î¤F¡K
¯uªº¤Ó·PÁ¤F¡C

¦Û§Ú·Pı¨}¦n

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

¶Ã§ï¤@³q.rar (16.61 KB)

¤U¸ü¦¸¼Æ: 12

2015-5-31 07:45

¥~¦æ¤H§â¥¦§ï¦¨³o¼Ë¡Aµ{¦¡À³¸ÓÁÙ¥i¥H§ó²©öªº

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
    '²M°£¤w¦³ªº¸ÑÄÀ¤Î­µ¼Ð
    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
                        '±qYahoo¦r¨åºK¨ú²Ä¤@²Õ¤¤¤å½Ķ
                    
                         If InStr(.responseText, "><h4>1.") > 0 Then rng.Offset(0, 2) = Trim(Split(Split(.responseText, "><h4>1.")(1), "<")(0))
                        'ºK¨úKK­µ¼Ð
                        If InStr(.responseText, ">KK[") > 0 Then rng.Offset(0, 1) = "[" & Split(Split(.responseText, ">KK[")(1), "]")(0) & "]"
                        .Open "get", iurl2 & rng, False
                        .send
                        '±qDICT.TW ­^º~¦r¨åÂ^¨ú¦r¸q
                        If InStr(.responseText, "</span><br /> &nbsp;") > 0 Then rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
                    End With
             End If
    Next
End Sub

brianhau

½Ð°Ý
§Ú·Q­n¦Û¤v¨Ó¸Õ¸Õ¬Ý
³o¬qµ{¦¡½X­n¶K¦bEXCELªº­þ¸Ì¤~¯à¨Ï¥Î©O¡H