Замена кодов символов 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

16343 просмотра

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

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

Игорь (администратор сайта), 2 Апр 2013 - 16:00.#1

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

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

Антон, 2 Апр 2013 - 14:39.#2

Воспользовался вашим макросом.
При обработке значений вида
&#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舡

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

Комментарии

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

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

НАДСТРОЙКИ ДЛЯ EXCEL