将西里尔字母替换为拉丁文答案

【问题标题】：replace cyrillic letters to latin将西里尔字母替换为拉丁文
【发布时间】：2017-06-19 01:57:19
【问题描述】：

我想在 VBA 中制作宏，将西里尔字母翻译成拉丁字母。
目前，我使用

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
    .Text = "Ш"    'cyrillic letter
    .Replacement.Text = "Sh"  'latin letter

    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

并为所有字母重复。这种方法有效。但它对大型文档的处理速度很慢，因为要调用 Selection.Find.Execute 的次数超过 50 次。

问：我可以更快地解决它吗？例如，像

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
    .Text = "^$"  'Finds any letter
    .Replacement.Text = "\\1"  ' ---> There I don't know how retrieve 
                               '    found letter 


    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False

    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

或者我可以用其他方式（Application.ActiveDocument.Characters 或 Application.ActiveDocument.Words 等）解决它，而不会丢失格式？

【问题讨论】：

您需要测试哪个更快，使用查找或循环文档的字符。应该可以在 ActiveDocument.Characters 中执行类似 For Each c 的操作来“遍历”文档中的每个字符。但问题仍然是如何识别字符及其替换。如果您知道西里尔字符的 unicode 数字，那么您可以测试该数字并“查找”等价的数字。例如“sh”字符： If Chr(c.Text) = 1064 Then ' 并在此处调用一个返回“sh”的函数，您将其写入文档。
我知道如何走 ActiveDocument.Characters ，但不知道替换它的内容？
基于我之前评论中的 sn-p，使用对象 c: c.Text = "sh"。仔细想想，当您用多个字符替换单个字符时，这可能会让 Word 感到困惑。在后台编写第二个文档可能更有意义，而不是在工作时更改原始文档...

标签： vba replace find ms-word

【解决方案1】：

这是我会使用的：

如果可能，删除选择并将其设置为范围。

禁用 ScreenUpdating，应该会更好。

Sub Replacer()

Dim rng1 As Range

call onstart

Set rng1 = Activedocument.Range

With rng1.Find
    .Text = "Ш"    'cyrillic letter
    .Replacement.Text = "Sh"  'latin letter

    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With

call onend

End Sub

Public Sub OnEnd()

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.StatusBar = False

End Sub

Public Sub OnStart()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

End Sub

【讨论】：