人气 3074

Excel成语查询 [复制链接]

lubansoft 2016-12-21 15:38:05
前面我们也介绍过部分网抓实例。通过调用网页的数据来填充我们需要的内容。这个实例是成语查询的,通过输入成语,获取拼音和释义。
作者:小林子-Office中国Excel成语查询操作动画

1482306374137749.gif

1482306374137749.gif

Excel成语查询详细VBA代码:      Function cy(str As String) As String
  On Error Resume Next  Application.ScreenUpdating = False  Dim 网址 As String  网址 = "http://v.juhe.cn/chengyu/query?key=eea5bd36b4ccb905347b22014b4307c5&dtype=xml&word="  Dim 成语 As String  成语 = UrlEncode(str)  Dim ARR1() As String  Dim objXML As Object  Dim txtContent As String
  Set objXML = CreateObject("Microsoft.XMLHTTP")  With objXML    .Open "GET", 网址 & 成语, False    .send    If objXML.Status = 200 Then      txtContent = .responsetext      ARR1 = Split(txtContent, ">")            cy = Left(ARR1(10), Len(ARR1(10)) - 8) & " " & Left(ARR1(12), Len(ARR1(12)) - 11)        Else          MsgBox "下载网页数据失败"         End If       End With      'Set objXML = Nothing     ThisWorkbook.Save     Application.ScreenUpdating = True   End Function
'把汉字转换成url字符编码Public Function UrlEncode(ByRef szString As String) As String  Dim szChar As String  Dim szTemp As String  Dim szCode As String  Dim szHex As String  Dim szBin As String  Dim iCount1 As Integer  Dim iCount2 As Integer  Dim iStrLen1 As Integer  Dim iStrLen2 As Integer  Dim lResult As Long  Dim lAscVal As Long  szString = Trim$(szString)  iStrLen1 = Len(szString)  For iCount1 = 1 To iStrLen1   szChar = Mid$(szString, iCount1, 1)   lAscVal = AscW(szChar)   If lAscVal >= &H0 And lAscVal = &H30 And lAscVal = &H41 And lAscVal = &H61 And lAscVal 点击加入群:Excel部落结识Excel大神学好Excel,效率成倍提高,薪水稳步增长,职位快速提升
每天一个源创技巧,如觉得有用,请点上面关注。更重要手机转发分享
您需要登录后才可以回帖 登录 | 立即注册

QQ|手机版|精益人 ( 沪ICP备19004111号-1 )|网站地图

GMT+8, 2024-12-22 18:25 , Processed in 0.248791 second(s), 23 queries .

Powered by Lean.ren X3.5 Licensed  © 2001-2030 LEAN.REN