Возможна ли замена Диакритических знаков через vba

Kreol2013

Пользователь

Сообщений: 621 Регистрация: 01.01.1970

01.04.2013 23:33:12

Господа приветствую.
Подскажите как выйти из ситуации.
Возможно ли через стандартную а может и нестандартную замену символов, получить читабельные символы.
В тексте

Код

<p class=left><span lang=EN-GB  id=capskr>vi&#7693-ambayati</span><span lang=EN-GB>  v PPP <span  id=capskr>vi&#7693-ambita</span>imitate, equal (A)- mock, cheat, deceive.</span></p></p></td><td width="200">

заменяя через vba, записано макрорекодером

Код

Cells.Replace What:="&#7771-", Replacement:="?", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Replace What:="&#7693-", Replacement:="?", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   'и тд.

вместо ? получить реальные значения.
ṛ | ṣ | ṃ | é | Ā | ñ |ḍ | ṭ | á | í | ū | ī | ś | ó | ṇ | √ | ḷ |ā | – | ú | Ś |ḥ | © | ṛ | ’ |

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

Прикрепленные файлы

Замена Диакритики(форум).xls (32 КБ)

Hugo Пользователь Сообщений: 26455 Регистрация: 22.12.2012	#2 01.04.2013 23:54:10 Используйте в коде chrw(номер) Номера у Вас есть - например ṛ = ChrW(7771)

EducatedFool

Пользователь

Сообщений: 3696 Регистрация: 23.12.2012

02.04.2013 03:32:17

Да, возможна.
Буквально вчера такое сделал:
http://excelvba.ru/code/ReplaceUnicode

Вам осталось только добавить цикл по ячейкам (лучше предварительно считать значения ячеек в массив),
и немного подправить шаблон замены (вместо \u в вашем случае будет &#)

Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Kreol2013 Пользователь Сообщений: 621 Регистрация: 01.01.1970	#4 02.04.2013 09:23:15 Благодарю!

Kreol2013

Пользователь

Сообщений: 621 Регистрация: 01.01.1970

02.04.2013 13:25:01

Цитата
EducatedFool пишет: (вместо \u в вашем случае будет &# )

Попробовал, загрузил, получил вместо ? японские иероглифы, но никак не диакитика).
Подскажите где лаж

Код

蜰 <spanid=cs>皓amb</span>, 舠mock舡
蜰 <spanid=cs>皓val</span>, 舠mix舡
蜰 <spanid=cs>睱c</span>
蜰 <spanid=cs>皓ʙ</span>, 舠fly舡
蜰 <spanid=cs>睱d</span>, <spanid=cs>ard</span>, 舠stir, dissolve舡
蜰 <spanid=cs>睱t</span>, <spanid=cs>art</span>, 舠pursue舡
蜰 <spanid=cs>睱dh</span>, 舠thrive舡

Картинка удалена модератором, так как ссылка не действительна

Kreol2013

Пользователь

Сообщений: 621 Регистрация: 01.01.1970

02.04.2013 13:34:08

Код
charcode& = Val(Replace(code$, "&#", "&H")) ' получаем код символа charcode& = Val(Replace(code$, "&#", "")) ' получаем код символа

решает проблему.

Цитата
Hugo пишет: Используйте в коде chrw(номер) Номера у Вас есть - например ṛ = ChrW(7771)

Спасибо.

EducatedFool Пользователь Сообщений: 3696 Регистрация: 23.12.2012	#7 02.04.2013 16:29:23 Ответил в комментах у себя на сайте: http://excelvba.ru/code/ReplaceUnicode#comment-2132 Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Антон

Пользователь

Сообщений: 621 Регистрация: 01.01.1970

01.10.2013 12:24:32

господа, я ничего не могу понять. я пытаюсь заменить в строке символ на диакритический знак, но почему-то получаю вместо u с макроном (ū) простую u.
Подскажите, что я делаю не так?

Скрытый текст

Код

'имеем
fields = "Su_"
'хочу получить 
 fields = "Sū"
'получаю
fields = "Su"
Public Function Convert_IAST_HK_name(fields)
Dim r As Integer
Dim r2 As Integer
Dim fields1 As String
    diakr_small_orig = Array(ChrW(257), ChrW(299), ChrW(363), ChrW(7771), ChrW(7773), ChrW(7735), ChrW(7737), ChrW(7747), ChrW(7717), ChrW(7749), ChrW(241), ChrW(7789), ChrW(7693), ChrW(7751), ChrW(231), ChrW(7779), ChrW(347))
    diakr_small_save = Array("a_", "i_", "u_", "r1", "r2", "l1", "l2", "m_", "h_", "n1", "n2", "t_", "d_", "n3", "s1", "s2", "s3")
    diakr_LARGE_orig = Array(ChrW(256), ChrW(298), ChrW(362), ChrW(7770), ChrW(7772), ChrW(7738), ChrW(7736), ChrW(7744), ChrW(7716), ChrW(7748), ChrW(209), ChrW(7788), ChrW(7692), ChrW(7750), ChrW(199), ChrW(7778), ChrW(346))
    diakr_LARGE_save = Array("A_", "I_", "U_", "R1", "R2", "L1", "L2", "M_", "H_", "N1", "N2", "T_", "D_", "N3", "S1", "S2", "S3")
    fields1 = fields
    For r = 0 To UBound(diakr_small_orig)
    fields1 = VBA.Replace(Expression:=fields1, Find:=diakr_small_save(r), Replace:=diakr_small_orig(r), Compare:=vbBinaryCompare)
    'fields1 = Replace(fields1, diakr_small_save(r), diakr_small_orig(r))
    Next r
    For r = 0 To UBound(diakr_LARGE_orig)
    'fields1 = Replace(fields1, diakr_LARGE_save(r), diakr_LARGE_orig(r))
    fields1 = VBA.Replace(Expression:=fields1, Find:=diakr_LARGE_save(r), Replace:=diakr_LARGE_orig(r), Compare:=vbBinaryCompare)
    Next r
' режем если первая буква/слог (a  ā  i  ī  u  ū  ṛ  ṝ  ḷ  e  ai o  au)
    If (Left(fields1, 1) = ChrW(257)) Or (Left(fields1, 1) = ChrW(299)) Or (Left(fields1, 1) = ChrW(363)) Or (Left(fields1, 1) = "a") Or (Left(fields1, 1) = "i") Or (Left(fields1, 1) = "u") Or (Left(fields1, 1) = "A") Or (Left(fields1, 1) = "I") Or (Left(fields1, 1) = "U") Or (Left(fields1, 1) = ChrW(256)) Or (Left(fields1, 1) = ChrW(298)) Or (Left(fields1, 1) = ChrW(362)) Or (Left(fields1, 1) = "e") Or (Left(fields1, 1) = "o") Or (Left(fields1, 1) = "E") Or (Left(fields1, 1) = "O") Or (Left(fields1, 1) = ChrW(7771)) Or (Left(fields1, 1) = ChrW(7773)) Then
        fields = Left(fields, 1)
    Else
        fields = Left(fields1, 2)
    End If
    Convert_IAST_HK_name = fields1
End Function

Hugo Пользователь Сообщений: 26455 Регистрация: 22.12.2012	#9 01.10.2013 12:35:06 Всё работает - на листе в D2 Su_ и где-то =Convert_IAST_HK_name(D2), код в стандарном модуле. Изменено: Hugo - 01.10.2013 12:35:35

Читают тему