Excel交流网
  • 设为首页|收藏本站|手机版
  • Excel-教程-技巧-培训视频

  • 网站首页
  • Excel教程
  • 关于我们
  • 新闻动态
  • Excel资源
  • 招贤纳士

Excel教程

Excel操作
Excel函数
Excel图表
Excel VBA
Excel 行业应用

联系方式

Excel中国 联系方式
电  话:400-855-3990
邮  编:528400
Email:support@zstm.com
网  址:www.excel-cn.com

当前位置:网站首页 > Excel教程 > Excel VBA
Excel VBA

Excel成语查询

前面我们也介绍过部分网抓实例。通过调用网页的数据来填充我们需要的内容。

这个实例是成语查询的,通过输入成语,获取拼音和释义。


作者:小林子-Office中国

 

Excel成语查询操作动画

成语.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 <= &HFF Then

                   If (lAscVal >= &H30 And lAscVal <= &H39) Or _

                     (lAscVal >= &H41 And lAscVal <= &H5A) Or _

                     (lAscVal >= &H61 And lAscVal <= &H7A) Then

                     szCode = szCode & szChar

                   Else

                    

                     szCode = szCode & "%" & Hex(AscW(szChar))

                   End If

                  Else

                   szHex = Hex(AscW(szChar))

                   iStrLen2 = Len(szHex)

                   For iCount2 = 1 To iStrLen2

                     szChar = Mid$(szHex, iCount2, 1)

                     Select Case szChar

                         Case Is = "0"

                           szBin = szBin & "0000"

                         Case Is = "1"

                           szBin = szBin & "0001"

                         Case Is = "2"

                           szBin = szBin & "0010"

                         Case Is = "3"

                           szBin = szBin & "0011"

                         Case Is = "4"

                           szBin = szBin & "0100"

                         Case Is = "5"

                        szBin = szBin & "0101"

                         Case Is = "6"

                           szBin = szBin & "0110"

                         Case Is = "7"

                           szBin = szBin & "0111"

                         Case Is = "8"

                           szBin = szBin & "1000"

                         Case Is = "9"

                           szBin = szBin & "1001"

                         Case Is = "A"

                           szBin = szBin & "1010"

                         Case Is = "B"

                           szBin = szBin & "1011"

                         Case Is = "C"

                           szBin = szBin & "1100"

                         Case Is = "D"

                           szBin = szBin & "1101"

                         Case Is = "E"

                           szBin = szBin & "1110"

                         Case Is = "F"

                           szBin = szBin & "1111"

                         Case Else

                     End Select

                   Next iCount2

                   szTemp = "1110" & Left$(szBin, 4) & "10" & Mid$(szBin, 5, 6) & "10" & Right$(szBin, 6)

                   For iCount2 = 1 To 24

                     If Mid$(szTemp, iCount2, 1) = "1" Then

                       lResult = lResult + 1 * 2 ^ (24 - iCount2)

                     Else: lResult = lResult + 0 * 2 ^ (24 - iCount2)

                     End If

                   Next iCount2

                   szTemp = Hex(lResult)

                      szCode = szCode & "%" & Left$(szTemp, 2) & "%" & Mid$(szTemp, 3, 2) & "%" & Right$(szTemp, 2)

                  End If

                  szBin = vbNullString

                  lResult = 0

                Next iCount1

                UrlEncode = szCode

            End Function



点击加入群:Excel部落 结识Excel大神
学好Excel,效率成倍提高,薪水稳步增长,职位快速提升
每天一个源创技巧,如觉得有用,请点上面 关注。更重要手机转发分享




如喜欢此技巧,手机右上角点开,分享到QQ空间,方便自己以后看




点击次数:  更新时间:2016-12-21 15:38:05  【打印此页】  【关闭】
上一条:Excel VBA 提取数据一则  下一条:Excel迷你信号图
本站动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图|网站管理

中山市天鸣科技发展有限公司 版权所有 1999-2020 粤ICP备10043721号

广东省中山市西苑广场富贵阁 528400

QQ:4008553990 电话:0760-88315075

Excel交流网主要交流Excel教程、Excel技巧、Excel培训、Excel函数公式、Excel图表以及Excel VBA,为网友提供一个最全的Excel交流网站

Excel教程|Excel技巧|Excel培训|Excel函数公式|Excel图表|VBA

Powered by MetInfo 5.3.12 ©2008-2022  www.metinfo.cn