cautionkimo

Sub searchITxx(rng As Range)
    Dim XH As Object
    Dim iurl, iurl2 As String
    iurl = "http://tw.dictionary.search.yahoo.com/search?p="
    iurl2 = "http://dict.tw/index.pl?query="
    With rng.EntireRow
        .Resize(1, .Columns.Count - 1).Offset(0, 1).Clear
    End With
    '開啟網頁
    Set XH = CreateObject("Microsoft.XMLHTTP")
    With XH
        .Open "get", iurl & rng, False
        .send
        
        On Error Resume Next
        '從Yahoo字典摘取第一組中文翻譯
        rng.Offset(0, 2) = Split(Split(.responseText, "<p class=""explanation"">")(1), "<")(0)

        '摘取KK音標
        rng.Offset(0, 1).Font.Name = "Arial Unicode MS"
        rng.Offset(0, 1).Size = 12
        rng.Offset(0, 1) = VBA.Split(VBA.Split(.responseText, """proun_value"">")(1), "<")(0)
        
        .Open "get", iurl2 & rng, False
        .send
        '從DICT.TW 英漢字典擷取字義
        rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
        
    End With
   
End Sub

cautionkimo

Sub 按鈕268_Click()

    Columns("B:B").Select
    With Selection.Font
        .Name = "Arial Unicode MS"
        .Size = 12
    End With
Range("a1").Select

Dim XH As Object

    Dim rng As Range
   
      Dim iurl, iurl2 As String
    '清除已有的解釋及音標
    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("a65536").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
                        '從Yahoo字典摘取第一組中文翻譯
                         rng.Offset(0, 2) = Split(Split(.responseText, "<p class=""explanation"">")(1), "<")(0)
                        '摘取KK音標
                         rng.Offset(0, 1) = Left(VBA.Split(.responseText, """proun_value"">")(1), InStr(VBA.Split(.responseText, """proun_value"">")(1), "]"))
                        .Open "get", iurl2 & rng, False
                        .send
                        '從DICT.TW 英漢字典擷取字義
                        rng.Offset(0, 3) = Split(Split(.responseText, "</span><br /> &nbsp;")(1), "<")(0)
                    End With
             End If
    Next
   
End Sub
不要叫我高手

自我感覺良好

回復 12# cautionkimo


    Dim rng .......Next
更好用
管你多少個單字
一鍵都搞定了