Excel中使用vba自定义函数对字符串继续url编码

admin

Excel中使用vba自定义函数对字符串继续url编码

Excel中使用vba自定义函数对字符串继续url编码

本文来自Kevin Yang博客 作者：Kevin Yang

Excel是个非常强大的工具，工作中因为需要用到他老完成一些表格数据的处理，所以抽空学了一点小技巧。

VBA是Visual Basic Application的全称，我们在Office的产品家族里面会经常看到它的身影。甚至SQL Server里头也有它的足迹，善于使用这些VBA函数或者自定义一些函数能够帮我们实现一些看似很强大的功能而又不用花费太大的精力。

步骤一. 打开Excel 2007中的Visual Basic编辑器

在Excel 2007中的开发工具菜单下，点击Visual Basic，即可弹出Visual Basic的编辑界面。默认情况下，这个开发工具在功能区是不显示的，需要在Excel设置中勾选上，如下图。

步骤二. 编写自定义函数

选择菜单->插入->模块，就会弹出一个编辑窗口，在其中输入下面代码，即可定义一个UrlEncode的函数。

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 = szCodeEnd Function

步骤三：测试

定义完之后，我们选择菜单->文件->关闭并返回Excel。然后我们就可以在Excel中测试刚才定义的这个函数了。如下图所示。

注意，使用了VBA函数的excel文件需要在打开时启用宏，否则函数无效。