最近在做SEM需要监控每个关键词的效果，就需要给每个关键词都加一个监控链接 生成监控链接的时候需要把每个中文关键词都转换成url编码 有1000多个词每个都手动生成url 要累死，通过观察发现其实每个监控链接 在变的就是关键词那个标签 只需要把 关键词转成url编码然后 批量把关键词前面的链接和关键词后边的链接拖一下 就ok了
那么就需要批量吧 1000个关键词都转成 url编码 找了半天 终于找到一个 通过excel 实现 中文url编码批量转化 的方法，记录一下，以后也许还会用到
1、打开 excel 在工具栏空白处右键--自定义功能区 把 开发工具这个工具打勾
2、点 这个
把下面的代码复制到 右边的模块里就ok了
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
3、在A1随便写个汉字，然后在B1 写这个函数 " =UrlEncode(A1) " 写好后直接回车 就ok了 批量的话直接拖就ok
怎么样是不是很酷
附：把 url编码 批量 转成汉字的方法
Function URLDecode(ByVal strIn)
URLDecode = ""
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
URLDecode = URLDecode & 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
URLDecode = URLDecode & 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
URLDecode = URLDecode & 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
URLDecode = URLDecode & Chr(a)
End Select
tl = sl
sl = InStr(sl, strIn, key, 1)
Loop
URLDecode = URLDecode & Mid(strIn, tl)
End Function
提示最后用函数的时候 写这个函数 " =URLDecode(A1) " 就ok
评论列表: