使用替换功能将一个字符替换为两个字符

Question

我正在尝试将重音字符转换为常规字符。某些字符需要替换为两个字符。我试过MID(string,i,2)。

Function ChangeAccent(thestring As String)
Dim A As String * 1
Dim B As String * 1
Dim C As String * 1
Dim D As String * 1
Dim i As Integer

Const LatChars="ßÄÖÜäöü"
Const OrgChars= "SSAEOEUEaeoeue"
For i = 1 To Len(LatChars)
    A = Mid(LatChars, i, 1)
    B = Mid(OrgChars, i, 2)
    thestring = Replace(thestring, A, B)
Next

Const AccChars="ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars= "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
    C = Mid(AccChars, i, 1)
    D = Mid(RegChars, i, 1)
    thestring = Replace(thestring, C, D)
Next

ChangeAccent = thestring
End Function

代码正在逐个替换（1个字符乘1个字符）。

我想在变量LatChars中用OrgChars中的2个字符替换一个字符。即ß带SS，Ä带AE等等。

Mid(OrgChars, i,2)未提取两个字符。

Answer 1

一种方法是使用两个arrays。一个包含您要替换的角色，另一个包含替换角色。此方法取决于两个阵列彼此同步。第一个数组中的元素1必须与第二个数组中的元素1匹配，依此类推。

此方法允许您忽略字符串长度。不再需要单独处理1和2个字符替换字符串。此代码还可以扩展为3,4或更多字符替换，而无需更改逻辑。

我已经使用split函数来构建数组。我发现在键入代码时节省了时间。但您可能更喜欢单独定义元素，这可以说更容易阅读。

示例

Sub Demo001()
' Demos how to replace special charaters of various lenghts.

    Dim ReplaceThis() As String     ' Array of characters to replace.
    Dim WithThis() As String        ' Array of replacement characters.
    Dim c As Integer                ' Counter to loop over array.
    Dim Sample As String            ' Contains demo string.

        ' Set up demo string.
        Sample = "ß - Ä - Š"

        ' Create arrays using split function and comma delimitor.
        ReplaceThis = Split("ß,Ä,Š", ",")
        WithThis = Split("SS,AE,S", ",")

        ' Loop over replacements.
        For c = LBound(ReplaceThis) To UBound(ReplaceThis)
            Sample = Replace(Sample, ReplaceThis(c), WithThis(c))
        Next

        ' Show result.
        MsgBox Sample
End Sub

<强>返回

SS - AE - S

编辑：在第一次尝试被误解后重写的答案 - 并没有回答 - 操作问题

Answer 2

B = Mid(OrgChars, i,2) 

应该是

B = Mid(OrgChars, i*2-1,2) 

Answer 3

小改动：

  

Dim B As String * 2

     

B = Mid（OrgChars，i * 2 - 1,2）

Option Explicit
Function ChangeAccent(thestring As String)
Dim A As String * 1
Dim B As String * 2
Dim C As String * 1
Dim D As String * 1
Dim i As Integer

Const LatChars = "ßÄÖÜäöü"
Const OrgChars = "SSAEOEUEaeoeue"
For i = 1 To Len(LatChars)
    A = Mid(LatChars, i, 1)
    B = Mid(OrgChars, i * 2 - 1, 2)
    thestring = Replace(thestring, A, B)
Next

Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
C = Mid(AccChars, i, 1)
D = Mid(RegChars, i, 1)
thestring = Replace(thestring, C, D)
Next

ChangeAccent = thestring
End Function