Reputation: 373
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
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
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
Reputation: 2357
B = Mid(OrgChars, i,2)
Should probably be
B = Mid(OrgChars, i*2-1,2)
Upvotes: 1