EXCEL Url编码和解码函数

香川群子

wudaicai 发表于 2015-4-28 14:36
这个自定义函数的格式没看懂，怎么用啊
比如A1单元格的内容是  %D6%D0%B9%FA   ，
我在B1单元格要解码它 ...

代码复制后粘贴到工作表模块中，然后就可以在任意单元格内直接引用。(和普通函数一样用)

Book2.zip (7.31 KB, 下载次数: 296)

2015-4-29 16:50 上传

点击文件名下载附件

王小妞‘

膜拜下大神们~谢啦！

cumulonimbus

4b4f439e-40a0153c-0140-a0226b98-0268
4b4f439e-40a0153c-0140-a0226b98-026b
4b4f439e-40a0153c-0140-a0226bb7-03f3
4b4f439e-40a0153c-0140-a0226b89-01cc
4b4f439e-40a0153c-0140-a0226bb7-03c0
4b4f439e-40a0153c-0140-a0226bb7-038f
请问大哥，这个如何解码？

bl5062

香川群子 发表于 2015-4-29 16:51
代码复制后粘贴到工作表模块中，然后就可以在任意单元格内直接引用。(和普通函数一样用)

%E5%8F%A4%E5%B7%B4-%E9%82%A3%E8%BE%86%E6%97%A7%E8%BD%A6-%E6%A3%AE%E6%9E%97-%E7%BA%A2%E8%89%B2-%E6%A3%95%E8%A4%90%E8%89%B2-%E6%97%85%E8%A1%8C-%E5%8E%9F%E7%94%9F%E6%9E%97-%E6%B1%BD%E8%BD%A6-%E5%86%92%E9%99%A9
古巴-那辆旧车-森林-红色-棕褐色-旅行-原生林-汽车-冒险
鍙ゅ反 ?>嬭niz~嬟妫�鏋� {?垱妫曡�愯�?ix^?鍘熺敓鏋?k迡?鍐掗櫓

这3行分别是，url 和两种函数 解码结果.这个代码短的是不是需要哪里设置一下？

blanksoul12

留個位置，謝謝

yuchu_1112

看不懂，学习中··

592rmb

恩，这个也很有用，不然网抓出来的乱码就没法处理了

t13564865256

香川群子 发表于 2015-4-10 11:14
你那些个函数太差劲了，都扔掉吧！

看我的：

我说你写的再简洁 算法再高深 是错的有什么用呢。你自己测试过吗？

t13564865256

附上正确的转码解码函数。别再误导了
Public Function UrlEncodeForUTF8(ByRef szString As String) As String  '中文转UTF-8 URL编码
       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
       UrlEncodeForUTF8 = szCode
End Function
Function URLDecodeForUTF8(ByVal strIn As String) As String
    URLDecodeForUTF8 = ""
    Dim sl: sl = 1
    Dim tl: tl = 1
    Dim key: key = "%"
    Dim kl: kl = Len(key)
    sl = InStr(sl, strIn, key, 1)
    Do While sl > 0
        If (tl = 1 And sl <> 1) Or tl < sl Then
            URLDecodeForUTF8 = URLDecodeForUTF8 & Mid(strIn, tl, sl - tl)
        End If
        Dim hh, hi, hl
        Dim a
        Select Case UCase(Mid(strIn, sl + kl, 1))
            Case "U" 'Unicode URLEncode
                a = Mid(strIn, sl + kl + 1, 4)
                URLDecode = URLDecode & ChrW("&H" & a)
                sl = sl + 6
            Case "E" 'UTF-8 URLEncode
                hh = Mid(strIn, sl + kl, 2)
                a = Int("&H" & hh) 'ascii码
                If Abs(a) < 128 Then
                    sl = sl + 3
                    URLDecodeForUTF8 = URLDecodeForUTF8 & Chr(a)
                Else
                    hi = Mid(strIn, sl + 3 + kl, 2)
                    hl = Mid(strIn, sl + 6 + kl, 2)
                    a = ("&H" & hh And &HF) * 2 ^ 12 Or ("&H" & hi And &H3F) * 2 ^ 6 Or ("&H" & hl And &H3F)
                    If a < 0 Then a = a + 65536
                    URLDecodeForUTF8 = URLDecodeForUTF8 & ChrW(a)
                    sl = sl + 9
                End If
            Case Else 'Asc URLEncode
                hh = Mid(strIn, sl + kl, 2) '高位
                a = Int("&H" & hh) 'ascii码
                If Abs(a) < 128 Then
                    sl = sl + 3
                Else
                    hi = Mid(strIn, sl + 3 + kl, 2) '低位
                    a = Int("&H" & hh & hi) '非ascii码
                    sl = sl + 6
                End If
                URLDecodeForUTF8 = URLDecodeForUTF8 & Chr(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecodeForUTF8 = URLDecodeForUTF8 & Mid(strIn, tl)
End Function

blackttea1

做个记号，谢谢