alex_gabriel
alex_gabriel

Reputation: 373

Replace one character with two using replace function

I am trying to convert accented characters to regular characters. Some characters need to be replaced with two characters. I tried 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

The code is working for one by one replacement (1 character by 1 character).

I want to replace one character in the variable LatChars with 2 characters in OrgChars. i.e ß with SS, Ä with AE and so on.

The Mid(OrgChars, i,2) is not extracting two characters.

Upvotes: 1

Views: 584

Answers (3)

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60414

Minor changes:

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

Upvotes: 1

David Rushton
David Rushton

Reputation: 5030

One method is to use two arrays. One that contains the character you wish to replace and the other its replacement. This method depends on both arrays being in sync with one another. Element 1 in the first array must match element 1 in the second, and so on.

This method allows you to ignore the string lengths. There is no longer any need to process 1 and 2 character replacement strings separately. This code can also scale to 3, 4 or more character replacements without a logic change.

I've used the split function to build the arrays. I find this saves time when typing out the code. But you may prefer to define the elements individually, which is arguably easier to read.

Example

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

Returns

SS - AE - S

EDIT: Answer rewritten as first attempt misunderstood - and did not answer - op question

Upvotes: 1

Abe Gold
Abe Gold

Reputation: 2357

B = Mid(OrgChars, i,2) 

Should probably be

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

Upvotes: 1

Related Questions