有没有更快的方法来替换重音字符？答案

【问题标题】：Is there a faster way to replace accented characters?有没有更快的方法来替换重音字符？
【发布时间】：2023-03-29 11:44:01
【问题描述】：

我有这段代码可以替换除第 6 行之外的所有重音字符。但是，这个宏需要很长时间，因为它会遍历每个单元格/字母，有什么方法可以通过忽略没有的单元格来加快速度'他们没有任何口音？

Const sFm As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Dim i As Long, employeews As Worksheet
Dim rowsix() As Variant

Set employeews = DestWb.Sheets(1)

'Don't replace row 6
rowsix = employeews.Rows(6).Value


For i = 1 To Len(sFm)
    employeews.Cells.Replace Mid(sFm, i, 1), Mid(sTo, i, 1), LookAt:=xlPart, MatchCase:=True
Next i

employeews.Rows(6).Value = rowsix

【问题讨论】：

我想选择一个我想替换其中的值的范围，然后循环遍历特殊字符以替换整个范围内的值。唯一要记住的真正警告是，这会影响公式。 For i = lbound(arr) to ubound(arr) // ws.range("a1:z5".replace(accentArr(i),noAccentArr(i))

标签： excel vba diacritics

【解决方案1】：

将注释作为答案，使代码更具可读性：

我会考虑选择一个我想在其中替换值的范围，然后循环遍历特殊字符以整体替换该范围内的值。唯一要记住的真正警告是，这会影响公式。

dim accentArr as variant, noAccentArr as variant
'accent and noaccent need to have same upper bound for this approach!
accentArr = Array("Š","Ž","š") 'quick mockup
noAccentArr = Array("S","Z","s") 
dim i as long
For i = lbound(accentArr) to ubound(accentArr)
    ws.range("a1:z5").replace(accentArr(i),noAccentArr(i))
Next i

而不是在单元格中逐个字符地进行，您至少对特定字符进行批量替换...这也允许您的 Range() 从第 7 行开始，不包括第 6 行。

后记，如果您想利用现有字符串而无需手动将字符串拆分为数组，请参阅：Split string into array of characters?。

【讨论】：

对 syntyax 的提示：认为没有有效的全局范围替换通过 ws.range("a1:z5").replace(accentArr(i),noAccentArr(i)) 并且单独站立而不分配回范围或数据字段:-)
[MS 帮助](docs.microsoft.com/de-de/office/vba/language/reference/…): Replace(expression, find, replace, [ start, [ count, [ compare ]]])

【解决方案2】：

与其他人所说的一致，并且并不真正知道您认为什么是糟糕的表现，您可以尝试这样的事情。它使用 dictionary 填充您的 from 和 to 字符串，拆分为字符及其替换，其中 from 是 key 而 to 是 item keys() 和 items() 字典是数组，所以使用它们而不是每次都对字符串进行切片，字典将再次可用。

Private d As Scripting.Dictionary

Const sFrom As String = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const sTo As String = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"

Sub PopulateReplacements()

Dim s As String
Dim l As Long

Set d = New Scripting.Dictionary

For l = 1 To Len(sFrom)
    If Not d.Exists(Mid(sFrom, l, 1)) Then _
                d.Add Mid(sFrom, l, 1), Mid(sTo, l, 1)
Next l

End Sub

Sub TestReplacing()

Dim s As String
Dim l As Long

s = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔ"
s = "_Ÿ_À_Á_Â_Ã_Ä_Å_Ç_È_É_Ê_Ë_Ì_Í_Î_Ï_Ð_Ñ_"
s = sFrom

If d Is Nothing Then
    PopulateReplacements
End If

For l = 0 To UBound(d.Keys())
    s = Replace(s, d.Keys()(l), d.Items()(l))
Next l

Debug.Print s

End Sub

【讨论】：