EXCEL2013以降の関数をEXCEL2010に移植 その２

EXCEL2010で使用できるように自作

 

Option Explicit

 

Function ENCODEURL(ByVal TextData As String) As String 'ENCODEURL関数（EXCEL2010で使用できるように自作）

 

Dim Data As Variant
Dim D() As String
Dim D2() As String
Dim i As Integer
Dim j As Integer

 

ReDim Data(Len(DataText))
ReDim D(Len(DataText) * 4)
ReDim D2(Len(DataText) * 3)

 

If DataText = "" Then
        ENCODEURL = CVErr(xlErrValue)
        Exit Function
End If

For i = 1 To Len(DataText)
    Data(i) = Hex(AscW(Mid$(DataText, i, 1)))
   
    For j = 1 To 4
        D(i * 4 - 4 + j) = Mid$(Data(i), j, 1)
    Next j
Next i

For i = 1 To Len(DataText)
    If Len(Data(i)) = 4 Then
            D2(i * 3 - 3 + 1) = "%" & Hex(Hex("&H" & D(i * 3 - 3 + 1) + &HE0))
            D2(i * 3 - 3 + 2) = "%" & Hex(Hex(("&H" & D(i * 3 - 3 + 2) * 4 + &H80) + ("&H" & D(i * 3 - 3 + 3) And &HC) / 4))
            D2(i * 3 - 3 + 3) = "%" & Hex(("&H" & (D(i * 3 - 3 + 3) & D(i * 3 - 3 + 4)) And &H3F) + &H80)
           
            ENCODEURL = ENCODEURL & D2(i * 3 - 3 + 1) & D2(i * 3 - 3 + 2) & D2(i * 3 - 3 + 3)
        Else
            If Data(i) = "2E" Then
                    ENCODEURL = ENCODEURL & Chr("&H" & Data(i))
                ElseIf (CDec("&H" & Data(i)) > 64) And (CDec("&H" & Data(i)) < 91) Then
                    ENCODEURL = ENCODEURL & Chr("&H" & Data(i))
                ElseIf (CDec("&H" & Data(i)) > 96) And (CDec("&H" & Data(i)) < 123) Then
                    ENCODEURL = ENCODEURL & Chr("&H" & Data(i))
                Else
                    ENCODEURL = ENCODEURL & "%" & Data(i)
            End If
    End If
   
Next i

 

End Function

 

以上。