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
Related
I have a list of words and I would like to find all symmetric words and some how put value 1 for each of them (see the picture).
This does the trick:
=1*(A1=CONCAT(MID(A1,LEN(A1)-SEQUENCE(1,LEN(A1),0),1)))
It reads the string in a cell backwards using MID and SEQUENCE, and compares the CONCAT result with the original to see if it is the same, i.e. the string is symmetric.
Multiplying by 1 forces the Boolean into an integer.
With VBA. This assumes that a single character is symmetric:
Public Function Sym(s As String) As Long
Dim L As Long, L2 As Long
Dim p1 As String, p2 As String
L = Len(s)
L2 = Int(L / 2)
Sym = 0
If L Mod 2 = 0 Then
' even
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 1))
If p1 = p2 Then
Sym = 1
End If
Else
' odd
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 2))
If p1 = p2 Then
Sym = 1
End If
End If
End Function
This will handle both an even or odd number of characters.
EDIT#1:
Simply:
Public Function Sym(s As String) As Long
Sym = 0
If s = StrReverse(s) Then Sym = 1
End
With Microsoft365, try:
Formula in B1:
=EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
Formula in C1:
=--EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
If you are working in a version without CONCAT() it will get significatly more verbose, but still possible:
=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1)
This, again, can be wrapped to return either 1 or 0 if you prefer that over the boolean results:
=--(=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1))
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.
Good day, experts. I'm getting 16 chars string value from uart, like this "0000000000001110", then i want to add space every 2 chars: "00 00 00 00 00 00 11 10". What i was thinking it's making for-next loop count every 2 chars in a "data", then add a space between it. But i'm really have no ideas how to accomplish it. That's what i tried so far:
Dim i As Long
Dim data As String = "0000000000001110"
For i = 0 To Len(data) Step 2 ' counting every 2 chars
data = Mid(data, i + 1, 2) ' assign 2 chars to data
' stucked here
Next i
Any input appreciated, thanks.
You can use a StringBuilder and a backwards loop:
Dim data As String = "0000000000001110"
Dim builder As New StringBuilder(data)
Dim startIndex = builder.Length - (builder.Length Mod 2)
For i As int32 = startIndex to 2 Step -2
builder.Insert(i, " "c)
Next i
data = builder.ToString()
The conditional operator(in VB If) using the Mod is used to find the start index(loooking from the end of the string). Because it will be different if the string has an even/odd number of characters. I use the backwards loop to prevent the problem that inserting characters changes the size of the string/StringBuilder, hence causing wrong indexes in the for-loop.
Here is an extension method that encapsulates the complexity and improves reusability:
Imports System.Runtime.CompilerServices
Imports System.Text
Module StringExtensions
<Extension()>
Public Function InsertEveryNthChar(str As String, inserString As String, nthChar As Int32) As String
If string.IsNullOrEmpty(str) then Return str
Dim builder as New StringBuilder(str)
Dim startIndex = builder.Length - (builder.Length Mod nthChar)
For i As int32 = startIndex to nthChar Step -nthChar
builder.Insert(i, inserString)
Next i
return builder.ToString()
End Function
End Module
Usage:
Dim data = "00000000000011101"
data = data.InsertEveryNthChar("[foo]", 3) ' 000[foo]000[foo]000[foo]000[foo]111[foo]01
I know you have already accepted an answer, however you could also do the required task like this.Make sure to import System.Text so you can use the StringBuilderOutput : 00 00 00 00 00 00 11 10
Dim data As String = "0000000000001110"
Dim sb As New StringBuilder()
Dim addSpace As Boolean = False
For Each c As Char In data
If addSpaceThen
sb.Append(c + " ")
addSpace = False
Else
sb.Append(c)
addSpace = True
End If
Next
sb.Length = sb.Length - 1 ''Remove last space on string
Console.WriteLine(sb.ToString())
If you NuGet "System.Interactive" you gt a very neat Buffer operator for IEnumerable(Of T). Then this works:
Dim data As String = "0000000000001110"
Dim result = String.Join(" ", data.Buffer(2).Select(Function (x) New String(x.ToArray())))
If you want to use straight LINQ then this works:
Dim result = String.Join(" ", data.Select(Function (x, n) New With { x, n }).GroupBy(Function (x) x.n \ 2, Function (x) x.x).Select(Function (y) New String(y.ToArray())))
'This is the easiest and a layman level solution
Dim i As Long
Dim A, b, C As String
A = Mid(mac, i + 1, 2) 'assign the first 2 value to the variable
C = A 'transfer it to main section
For i = 0 To Len(mac) - 4 Step 2 ' counting every 2 chars and looping should be 4 characters less.
b = Mid(mac, i + 3, 2) ' assign 2 chars to data
b = "-" + b'put the dashes in front of every other character
C = C + b
Next i
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
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