Replace one character with two using replace function - excel

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.

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

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

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

Related

VBA generate a code

there. I made this code that replaces a character for two number (e.g. 0 = 10; 1 = 11; 2 = 12; ...) and everything works fine except for the first element (the zero element). So, if I put "010a4" string on cell A1 and use my formula "=GENERATECODE(A1)", my expected return value is "1011102014" but I've got a "110111102014" string. So, only zero value occur this error and I can't figured out why. Any thoughts?
My code:
Function GENERATECODE(Code As String)
Dim A As String
Dim B As String
Dim i As Integer
Const AccChars = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
Const RegChars = "1011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, 2 * i - 1, 2)
Code = Replace(Code, A, B)
Next
GENERATECODE = Code
End Function
Your problem is that your code first change each 0 to 10 then each 1 to 11. So each 0 give you 10 then 110.
If you want to keep the same kind of algorithm (which might not be a good choice), you need to change AccChars and RegChars so that a character is never replaced by a string that can give a character found later on the AccChars String. In your case just replace Const AccChars = "012 ... per Const AccChars = "102 ... and Const RegChars = "101112 ... per Const RegChars = "111012 ...
But it might be better to change your algorithm altogether. I would first suggest to not use in place editing of the string, but rather to use 2 Strings.
In addition to being incorrect, your current code is inefficient since it involves scanning over the code string multiple times instead of just once. Simply scan over the string once, gathering the substitutions into an array which is joined at the end:
Function GENERATECODE(Code As String) As String
Dim codes As Variant
Dim i As Long, n As Long
Dim c As String
n = Len(Code)
ReDim codes(1 To n)
For i = 1 To n
c = Mid(Code, i, 1)
Select Case c
Case "0" To "9":
codes(i) = "1" & c
Case "a" To "z":
codes(i) = Asc(c) - 77
Case "A" To "Z":
codes(i) = Asc(c) - 19
Case Else:
codes(i) = "??"
End Select
Next i
GENERATECODE = Join(codes, "")
End Function
Example:
?generatecode("010a4")
1011102014
The point of the two offsets is that you want "a" to map to 20 and "A" to map to 46. Note Asc("a") - 77 = 97 - 77 and Asc("A") - 19 = 65-19 = 46.

Replace a string with a format string

I have the following input:
Dim str_format as string = "XXXXX00000"
Dim str as string = "INV"
Dim int as integer = "56"
How can I replace XXXXX with INV and replace 00000 with 56?
For the example above the result should be INVXX00056.
X can only replace with alphabet and 0 can only replace with integer, if str has more than five alphabet. The extra alphabets will be thrown away because str_format only has five X. The same algorithm is true for the integer.
Example 2
Dim str_format as string = "XXX00000"
Dim str as string = "ABCD"
Dim int as integer = 654321
Expected result: ABC54321
Process:
1. ABCD XXX00000 654321
2. ABC DXX000006 54321
3. AB CDX00065 4321
4. A BCD00654 321
5. ABC06543 21
6. ABC65432 1
7. ABC54321
As Spidey mentioned... show some code. That said the process you describe is a bit long-winded.
The Letter part of the solution can be done by grabbing the first 3 characters of str using Left(str,3) this will bring in the leftmost 3 character (if there are less it will get what is there). Then check that you have 3 characters using str.Length(). If the length is less than 3 then append the appropriate number of 'X'.
The Numeric part can be done in a similar way. Your int is actually a string in your code above. If it was a real integer you can cast it to string. Use Right(int,5). Again check to see you have 5 digits and if not prepend with appropriate number of 0.
Have a go... if you run into problems post your code and someone is bound to help.
UPDATE
As there have been actual answers posted here is my solution
Function FormatMyString(str As String, num as String) As String
Dim result As String
result = Left(str,3).PadRight(3, "X"c).ToUpper() & Right(num,5).PadLeft(5, "0"c)
Return result
End Function
UPDATE 2
based on Wiktors answer... made an amendment to my solution to cope with different formats
Function FormatMyString(str As String, num as String, alpha as Integer, digits as Integer) As String
Dim result As String
result = Left(str, alpha).PadRight(alpha, "X"c).ToUpper() & Right(num, digits).PadLeft(digits, "0"c)
Return result
End Function
To use...
FormatMyString("ABCDE", "56",3 5) will return ABC00056
FormatMyString("ABCDE", "123456",4 3) will return ABCD456
FormatMyString("AB", "123456",4 3) will return ABXX456
Here is a possible solution that just uses basic string methods and PadLeft/PadRight and a specific method to count occurrences of specific chars in the string. It assumes the format string can only contain X and 0 in the known order.
Public Function CountCharacter(ByVal value As String, ByVal ch As Char) As Integer
Return value.Count(Function(c As Char) c = ch)
End Function
Public Sub run1()
Dim str_format As String = "XXXXX00000" '"XXX00000"
Dim str As String = "INV"
Dim int As Integer = 56 ' ABC54321
Dim xCnt As Integer = CountCharacter(str_format, "X")
Dim zCnt As Integer = CountCharacter(str_format, "0")
Dim result As String
If xCnt > str.Length Then
result = str.PadRight(xCnt, "X")
Else
result = str.Substring(0, xCnt)
End If
If zCnt > int.ToString().Length Then
result = result & int.ToString().PadLeft(zCnt, "0")
Else
result = result & int.ToString().Substring(int.ToString().Length-zCnt
End If
Console.WriteLine(result)
End Sub
Output for your both scenarios is as expected.
Take a look at this sample
Dim str_format As String = str_format.Replace("XXX", "ABC")
Msgbox(str_format )
As we assume that the X is 3 only. I dont want to give you more it is a start and everything will be easy.
If that kind of format is fix I mean the number of X will go or down then you can make a conditional statement based on the length of string

Converting Special Characters into alphabet

I have an excel file with Name column which is in different language.I need to convert this names into Standard English language.
Example:
HỒ ĐĂNG TẤN has to be converted to HO DANG TAN.
NGUYỄN ĐỨC KIÊN - NGUYEN DUC KIEN
ĐOÀN THỊ THANH THẢO- DOAN THI THANH
Step 1: Open Microsoft Visual Basic for Applications window.
Step 2: Click Insert -> Module, and enter the following macro in the Module Window.
Function StripAccent(thestring As String)
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Const AccChars= "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const RegChars= "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
thestring = Replace(thestring, A, B)
Next
StripAccent = thestring
End Function
Step 3: Then go to a blank cell and paste the formula in a cell:
=CheckStringCHAR(InString)
for example =CheckStringCHAR("ù"), or =CheckStringCHAR(A2).
The list of characters is not exhaustive. more at http://en.wikipedia.org/wiki/List_of_Latin-script_letters#Letters_with_diacritics
Just for the fun of it, the below is a more efficient version of the function that is doing the rounds on the web pasted above as an answer.
Sample test results (100 loops of a 10,000 char strings). Times are milliseconds per call, picked up from QueryPerformanceTimer.
Old: Min: 57.6 ms, Mean: 65.4 ms
New: Min: 22.1 ms, Mean: 24.4 ms
The performance improvement comes from not creating new copies of the string at each replace, by instead replacing the characters in-place using the Mid$ statement.
Public Function StripAccent(ByVal txt As String) As String
Dim i As Long, j As Long, n As Long
Const c1 = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
Const c2 = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
n = Len(c1)
For i = 1 To n
j = 0
Do
j = InStr(j + 1, txt, Mid$(c1, i, 1), vbBinaryCompare)
If j > 0 Then Mid$(txt, j, 1) = Mid$(c2, i, 1) Else Exit Do
Loop
Next
StripAccent = txt
End Function

Dividing a string in groups of two

I have a Hex string that has a value like
26C726F026C426A1269A26AB26F026CC26E226C726E226CD
I was wondering how to split it into a string array, where each index of the array holds a group of 2 of those chars.
Example:
string(0)=26,string(1)=C7,string(2) = 26,string (3) = F0, and so on.
How can I do this?
Dim MyList as New List(Of String)
Dim s as String = "26C726F026C426A1269A26AB26F026CC26E226C726E226CD"
For x as Integer = 0 to s.Length - 1 step 2
MyList.Add(s.substring(x,2))
Next
You can get it with MyList(0), MyList(1) or etc

How can you convert HEX to BIN, one character at a time in EXCEL 2010

I am trying to find a way to take a string of HEX values and convert them to BIN. I need to convert 1 HEX character at a time:
For example: HEX = 0CEC
BIN = 0000 1100 1110 1100
I need to do this in Excel. Any help would be great.
Thanks,
Larry
In a module:
Public Function HEX2BIN(strHex As String) As String
Dim c As Long, i As Long, b As String * 4, j As Long
For c = 1 To Len(strHex)
b = "0000"
j = 0
i = Val("&H" & Mid$(strHex, c, 1))
While i > 0
Mid$(b, 4 - j, 1) = i Mod 2
i = i \ 2
j = j + 1
Wend
HEX2BIN = HEX2BIN & b & " "
Next
HEX2BIN = RTrim$(HEX2BIN)
End Function
For:
=HEX2BIN("0CEC")
0000 1100 1110 1100
Yes, I had to do this recently. I'm late to the game, but other people will have to do this from time to time, so I'll leave the code where everyone can find it:
Option Explicit
Public Function HexToBinary(strHex As String, Optional PadLeftZeroes As Long = 5, Optional Prefix As String = "oX") As String
Application.Volatile False
' Convert a hexadecimal string into a binary
' As this is for Excel, the binary is returned as string: there's a risk that it will be treated as a number and reformatted
' Code by Nigel Heffernan, June 2013. Http://Excellerando.Blogspot.co.uk THIS CODE IS IN THE PUBLIC DOMAIN
' Sample Usage:
'
' =HexToBinary("8E")
' oX0010001110
'
' =HexToBinary("7")
' oX001111
'
' =HexToBinary("&HD")
' oX01101
Dim lngHex As Long
Dim lngExp As Long
Dim lngPad As Long
Dim strOut As String
Dim strRev As String
If Left(strHex, 2) = "&H" Then
lngHex = CLng(strHex)
Else
lngHex = CLng("&H" & strHex)
End If
lngExp = 1
Do Until lngExp > lngHex
' loop, bitwise comparisons with successive powers of 2
' Where bitwise comparison is true, append "1", otherwise append 0
strRev = strRev & CStr(CBool(lngHex And lngExp) * -1)
lngExp = lngExp * 2
Loop
' As we've done this in ascending powers of 2, the results are in reverse order:
If strRev = "" Then
HexToBinary = "0"
Else
HexToBinary = VBA.Strings.StrReverse(strRev)
End If
' The result is padded by leading zeroes: this is the expected formatting when displaying binary data
If PadLeftZeroes > 0 Then
lngPad = PadLeftZeroes * ((Len(HexToBinary) \ PadLeftZeroes) + 1)
HexToBinary = Right(String(lngPad, "0") & HexToBinary, lngPad)
End If
HexToBinary = Prefix & HexToBinary
End Function
You can use HEX2BIN(number, [places]).
The HEX2BIN function syntax has the following arguments:
Number Required. The hexadecimal number you want to convert. Number cannot contain more than 10 characters. The most significant bit of number is the sign bit (40th bit from the right). The remaining 9 bits are magnitude bits. Negative numbers are represented using two's-complement notation.
Places Optional. The number of characters to use. If places is omitted, HEX2BIN uses the minimum number of characters necessary. Places is useful for padding the return value with leading 0s (zeros).
I would use a simple formula as follows:
=HEX2BIN(MID(S23,1,2))&HEX2BIN(MID(S23,3,2))&HEX2BIN(MID(S23,5,2))&HEX2BIN(MID(S23,7,2)&HEX2BIN(MID(S23,9,2)&HEX2BIN(MID(S23,11,2)&HEX2BIN(MID(S23,13,2))
cell S23 = BFBEB991, Result = 10111111101111101011100110010001
This would allow it to be as long you need. Just add as many repetitions as you need incrementing the start position by 2 (eg 1, 3, 5, 7, 9, 11, 13, 15, ....). Note that the missing characters will be ignored.
For me, it gives this (sorry, in VBA, but has the advantage of not asking you the length of your string to convert). Be careful, I put a comment in the lower part for which you can add a space between each section of 4 bits. Some don't want the space and some will need it:
Length = Len(string_to_analyse)
For i = 1 To Length
Value_test_hexa = Left(Right(string_to_analyse, Length - (i - 1)), 1)
'get the asci value of each hexa character (actually can work as a decimal to binary as well)
Value_test = Asc(Value_test_hexa)
If Value_test > 47 And Value_test < 58 Then
Value_test = Value_test - 48
End If
' Convert A to F letters to numbers from 10 to 15
If Value_test > 64 And Value_test < 71 Then
Value_test = Value_test - 55
End If
'identify the values of the 4 bits for each character (need to round down)
a = WorksheetFunction.RoundDown(Value_test / 8, 0)
b = WorksheetFunction.RoundDown((Value_test - a * 8) / 4, 0)
c = WorksheetFunction.RoundDown((Value_test - a * 8 - b * 4) / 2, 0)
d = (Value_test - a * 8 - b * 4 - c * 2)
Value_converted = Value_converted & a & b & c & d ' can eventually add & " " in order to put a space every 4 bits
Next i
Tested OK so you can go with it.
Just leaving this here for anyone who needs it.
Instead of manually converting from hex to binary, I used Excel's built-in HEX2BIN function.
Function hexToBin(hexStr As String) As String
Dim i As Integer, b As String, binStr As String
For i = 1 To Len(hexStr)
b = Application.hex2bin(Mid(hexStr, i, 1), 4)
binStr = binStr & b
Next i
hexToBin = binStr
End Function

Resources