mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Преобразование строки, содержащей кириллицу, в URLEncode

Пользовательская функция на VBA, которая преобразовывает Unicode (русский текст) в URLencode

Function RussianStringToURLEncode(ByVal txt As String) As String
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is > 256: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case 32: t = "+"
            Case Else: t = l
        End Select
        RussianStringToURLEncode = RussianStringToURLEncode & t
    Next
End Function

И что-то типа обратного преобразования - URLdecode:

Function URLDecode(ByVal strIn)
    ' взято здесь: zhaojunpeng.com/posts/2016/10/28/excel-urldecode
    ' в редакции EducatedFool
    On Error Resume Next
    Dim sl&, tl&, key$, kl&
    sl = 1:    tl = 1: key = "%": 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$, 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?
                    a = (Int("&H" & hh) - 194) * 64 + Int("&H" & hi)
                    sl = sl + 6
                End If
                URLDecode = URLDecode & ChrW(a)
        End Select
        tl = sl
        sl = InStr(sl, strIn, key, 1)
    Loop
    URLDecode = URLDecode & Mid(strIn, tl)
End Function


Еще один вариант функции:
Function RussianStringToURLEncode(ByVal txt As String) As String
    Dim i&, l$, t$
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is >= 256: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case Else: t = "%" & Hex(AscW(l) \ 16) & Hex(AscW(l) Mod 16)
        End Select
        RussianStringToURLEncode = RussianStringToURLEncode & t
    Next
End Function


новая версия
Function RussianStringToURLEncode_New(ByVal txt As String) As String
    For i = 1 To Len(txt)
        l = Mid(txt, i, 1)
        Select Case AscW(l)
            Case Is > 4095: t = "%" & Hex(AscW(l) \ 64 \ 64 + 224) & "%" & Hex(AscW(l) \ 64) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case Is > 127: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
            Case 32: t = "%20"
            Case Else: t = l
        End Select
        RussianStringToURLEncode_New = RussianStringToURLEncode_New & t
    Next
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

С п а с и б о!

Андрей, сделать что?
в какой кодировке у вас текстовая строка изначально? и в какую надо перевести? и зачем вообще это делаете?

Как сделать то же самое, но не для Unicode, а Windows-1251 ?

Спасибо, ребят, что вы существуете! Пошел писать функцию для rskript, за основу возьму ваш труд. =)

два пробела меняются на последовательность %20%20. Какую строку преобразуете и что получается?

Круто! Но есть маленький недочет, если в ссылке стоит 2 пробела подряд, они заменяются на 1 знак %20 и ссылка перестает работать, т.к. правильный вариант, когда 2 пробела заменяются на 2 знака %20%20. Как можно это исправить?

А как в exele это заюзать?

АААААА
СПАСИБО!!!!!!!!!!!!!11
Уже мозг начинал взрываться от поиска именно этого преобразования
Сейчас сижу и улыбаюсь монитору.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
 __        __              _____          _ 
\ \ / / ___ ____ | ____| __ __ (_)
\ \ /\ / / / __| |_ / | _| \ \/ / | |
\ V V / \__ \ / / | |___ > < | |
\_/\_/ |___/ /___| |_____| /_/\_\ |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.