Замена кодов символов Unicode на сами символы

Функция позволяет произвести замену в текстовой строке кодов символов Unicode на их значения

 

В функции используются регулярные выражения (RegExp)

Пример использования функции ReplaceUnicodeChars:

Sub ЗаменаКодовСимволовВСтроке()
    ' исходная текстовая строка, содержащая коды символов Unicode
    txt$ = "Санаторий\u2013профилакторий \u201dЛесная сказка\u201d приглашает Вас!"
 
    res$ = ReplaceUnicodeChars(txt)    ' заменяем коды на симолы

    Debug.Print res$    ' выводит: Санаторий–профилакторий ”Лесная сказка” приглашает Вас!
End Sub

 

Function ReplaceUnicodeChars(ByVal txt$) As String
    ' ищет в тексте txt$ коды символов Unicode (типа \u2013, \u201d)
    ' и заменяет коды этих символов на сами символы
    On Error Resume Next: Err.Clear
    Static REGEXP As Object
    If REGEXP Is Nothing Then
        Set REGEXP = CreateObject("VBScript.RegExp")
        REGEXP.Global = True
        REGEXP.Pattern = "\\u[0-9a-f]{4}"
    End If
    If REGEXP.test(txt) Then    ' если в тексте присутствуют коды символов
        Set objMatches = REGEXP.Execute(txt)
        For i = 0 To objMatches.Count - 1
            code$ = objMatches.Item(i).Value    ' очередной найденный код (например, \u201d)
            charcode& = Val(Replace(code$, "\u", "&H"))    ' получаем код символа
            If charcode& Then txt = Replace(txt, code$, ChrW(charcode&))    ' выполняем замену кода на символ
        Next
    End If
    ReplaceUnicodeChars = txt
End Function

Комментарии

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

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

вот так будет работать:

Sub ЗаменаКодовСимволов()
    ' исходная текстовая строка, содержащая коды символов Unicode
    txt$ = "&#8730- &#7693-val, &#8220-mix&#8221-"
    res$ = ReplaceUnicodeChars(txt)    ' заменяем коды на симолы
    Debug.Print res$    ' выводит: v ?val, “mix”
End Sub
 
Function ReplaceUnicodeChars(ByVal txt$) As String
    ' ищет в тексте txt$ коды символов Unicode (типа \u2013, \u201d)
    ' и заменяет коды этих символов на сами символы
    On Error Resume Next: Err.Clear
    Static REGEXP As Object
    If REGEXP Is Nothing Then
        Set REGEXP = CreateObject("VBScript.RegExp")
        REGEXP.Global = True
        REGEXP.Pattern = "&#[0-9a-f]{4}"
    End If
    If REGEXP.test(txt) Then    ' если в тексте присутствуют коды символов
        Set objMatches = REGEXP.Execute(txt)
        For i = 0 To objMatches.Count - 1
            code$ = objMatches.Item(i).Value
            charcode& = Val(Replace(code$, "&#", ""))    ' получаем код символа
            If charcode& Then txt = Replace(txt, code$ & "-", ChrW(charcode&))
        Next
    End If
    ReplaceUnicodeChars = txt
End Function

Воспользовался вашим макросом.
При обработке значений вида
&#8730- &#7693-val, &#8220-mix&#8221-
В код нужно внести изменения.
как правильно оформить код в комментарии не понял. прошу поправить
If REGEXP Is Nothing Then
Set REGEXP = CreateObject("VBScript.RegExp")
REGEXP.Global = True
REGEXP.Pattern = "&#[0-9a-f]{2,4}-"
End If
If REGEXP.test(txt) Then ' если в тексте присутствуют коды символов
Set objMatches = REGEXP.Execute(txt)
For i = 0 To objMatches.Count - 1
code$ = objMatches.Item(i).Value ' очередной найденный код (например, \u201d)
code$ = Replace(code$, "-", "")
'charcode& = Val(Replace(code$, "&#", "&H")) ' получаем код символа
charcode& = Val(Replace(code$, "&#", "")) ' получаем код символа
code$ = code$ & "-"
If charcode& Then txt = Replace(txt, code$, ChrW(charcode&)) ' выполняем замену кода на символ
Next
End If

тогда получим желаемое
√ ḍamb, “mock”
иначе 蜰 皓amb, 舠mock舡

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

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

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

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