I have some code as shown below that i found on a forum , that will convert ASCII Code to Hexadecimal Characters using a VBA script, is it possible to convert Hex Characters to ASCII Characters ??
The code i have is as follows
Sub AsciiToHex()
Dim strg As String
Dim tmp As String
strg = Worksheets("Sheet1").Range("A1")
Worksheets("Sheet1").Range("A5").value = strg
tmp = ""
For i = 1 To Len(strg)
tmp = tmp & hex((Asc(Mid(strg, i, 1))))
Next
Worksheets("Sheet1").Range("A6").value = tmp
End Sub
I have tried to to swap the hex((Asc(Mid(strg, i, 1)))) to Asc((hex(Mid(strg, i, 1)))) but that did not work. Any help would be appreciated
Sample Data
Hex Format
48 65 6C 6C 6F
After conversion would be the following
Ascii Format
H e l l o
Hex To String
Function HexToString(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString) Step 2
HexToString = HexToString & Chr("&H" & (Mid(InitialString, i, 2)))
Next i
End Function
Function StringToHex(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString)
StringToHex = StringToHex & Hex(Asc(Mid(InitialString, i, 1)))
Next i
End Function
How about:
Public Function KonvertHex(s As String) As String
KonvertHex = ""
For i = 1 To Len(s)
KonvertHex = KonvertHex & Asc(Mid(s, i, 1))
Next i
End Function
This uses the worksheet function Hex2Dec.
[a1:e1] = [{"48", "65", "6C", "6C", "6F"}]
For Each c In Range("a1:e1")
c.Offset(1, 0) = Chr(WorksheetFunction.Hex2Dec(c))
Next c
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.hex2dec
Related
I have 14 cells that contain Hex values - I need a way of calculating the checksum of these values. I know the idea is to convert all to decimal and add, then to convert to binary and inverse then plus 1 then convert to hex again - However I am unsure how to do this in VBA. The values are below.
0011 E200 10E0 6C00 33E9 1F88 C080 1800 8001 3030 305A 4A39 3436 1624
Convert all the decimal and add:
Dim hexVal as String
Dim hexValtoLong as Double
Dim hexValToLongF as Double
'Alternatively can put everything in a loop and add together
hexValToLongF = 0
hexVal = "10E0"
hexValToDouble = cdbl("&H" & hexVal)
hexValToLongF = hexValToDouble + hexValToLongF
'... repeat
Convert decimal to binary:
Public Function DecToBin(ByVal theDec As Variant) As String
Dim i As Long
For i = 31 To 0 Step -1
DecToBin = DecToBin & CStr(Int(theDec / (2 ^ i)))
theDec = theDec - Int(theDec / (2 ^ i)) * (2 ^ i)
Next i
End Function
source: http://www.vbaexpress.com/forum/showthread.php?3599-Solved-Convert-Decimal-To-Binary
Inverse binary string:
Public Function binverse(wCell As String) As String
Dim x, y As Integer
Dim nResult As String
nResult = vbNullString
x = Len(wCell)
For y = 1 To x
If Mid(wCell, y, 1) = "1" Then
nResult = nResult & "0"
Else
nResult = nResult & "1"
End If
Next
binverse = nResult
End Function
source: https://www.excelforum.com/excel-general/551647-binary-inverse.html
Convert binary to dec:
Private Function Bin2Dec(Bin As String) As Long
Dim TempVal As Long
Dim RevI As Long
Dim I As Long
For I = Len(Bin) To 1 Step -1
RevI = (Len(Bin) - I) + 1
Debug.Print RevI
If Mid(Bin, I, 1) = "1" Then TempVal = TempVal + (2 ^ (RevI - 1))
Next I
Bin2Dec = TempVal
End Function
source: http://www.vbforums.com/showthread.php?213436-Addition-of-Binary-Numbers-in-VB
Then add one to it, and use the provided function in vba Hex() to convert the number back to hex. Utilizing everything should give you a way to accomplish what you laid out initially in your post.
i have a file name the i need to remove some characters below is file name and the goal after trim filename.
My Current String = "text_12_12_19.pdl"
New String Goal = "Text.pdl"
You can use Split:
MyStringGoal = Split(MyCurrentString, "_")(0) & "." & Split(MyCurrentString, ".")(1)
Assuming you are looking to obtain all characters preceding the first underscore, I would suggest the following:
Function TrimFilename(fnm As String) As String
Dim i As Long, j As Long
i = InStr(fnm, "_")
j = InStrRev(fnm, ".")
If 0 < i And i < j Then
TrimFilename = Mid(fnm, 1, i - 1) & Mid(fnm, j)
Else
TrimFilename = fnm
End If
End Function
?TrimFilename("text_12_12_19.pdl")
text.pdl
'Another solution (can also use left and right) :
Dim my_current_string As String
Dim New_String_Goal As String
Dim r As String, l As String
my_current_string = "text_12_12_19.pdl"
l = Left(my_current_string, 4)
r = Right(my_current_string, 4)
New_String_Goal = l & r
Debug.Print New_String_Goal
I'm still learning how to make scripts in VBA.
For now I want to create script converting text from cell to Unicode Little Endian Hex. I have script that works now only for first character. How should i apply loop to switch to next letter, add it to print and finish script when text is over?
Function Text2LE(Character As String)
Dim x As Long
x = AscW(Character)
If x < 16 Then
Text2LE = "000" & Hex(AscW(Character))
Text2LE = Right(Text2LE, 2) & Left(Text2LE, 2)
ElseIf x < 256 Then
Text2LE = "00" & Hex(AscW(Character))
Text2LE = Right(Text2LE, 2) & Left(Text2LE, 2)
Else
Text2LE = "0" & Hex(AscW(Character))
Text2LE = Right(Text2LE, 2) & Left(Text2LE, 2)
End If
End Function
you need something like to loop through the Character in the string and convert it using your function! Then Group the HEX together and display or consume! (Not to sure on the display of hex in debug window)
sub Convert()
Dim i as long
Dim string_to_convert as string
Dim Hex as String
For i = 1 to len(string_to_convert)
Hex = Hex + Text2LE(Mid(string_to_convert, i, 1))
Next i
debug.Print Hex
end sub
theStr = "KT150"
Characters count is always 5 in total. I want to make sure that there is 3 numbers in theStr. How would I achieve this in Excel VBA?
You do not need VBA to get the number of digits in a string, but here is one way to count them:
Public Function KountNumbers(r As Range) As Long
Dim i As Long, t As String
t = r.Text
For i = 1 To Len(t)
If Mid(t, i, 1) Like "[0-9]" Then KountNumbers = KountNumbers + 1
Next i
End Function
for example:
Without VBA try this:
=SUMPRODUCT(LEN(A1)-LEN(SUBSTITUTE(A1,{0,1,2,3,4,5,6,7,8,9},"")))
to get the number of numeric digits.
Your question is a little lacking in detail, but how about:
Sub test()
Debug.Print containsXnumbers("KT150", 3)
End Sub
Function containsXnumbers(sInput As String, xNumbers As Long) As Boolean
Dim x As Long
Dim numCount As Long
For x = 1 To Len(sInput)
If IsNumeric(Mid(sInput, x, 1)) Then numCount = numCount + 1
Next x
If numCount = xNumbers Then containsXnumbers = True
End Function
This should help:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Example:
Dim myStr as String
myStr = onlyDigits ("3d1fgd4g1dg5d9gdg")
MsgBox (myStr)
Will return (in a message box):
314159
*Code is exact copy of this SO answer
try with the below formula
Assume that your data are in A1. Apply the below formula in B1
=IF(AND(LEN(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"1",""),"2",""),"3",""),"4",""),"5",""),"6",""),"7",""),"8",""),"9",""),"0",""))=2,LEN(A1)=5),"3 character numerals","No 3 numerals found")
How is it possible to split a VBA string into an array of characters?
I tried Split(my_string, "") but this didn't work.
Safest & simplest is to just loop;
Dim buff() As String
ReDim buff(Len(my_string) - 1)
For i = 1 To Len(my_string)
buff(i - 1) = Mid$(my_string, i, 1)
Next
If your guaranteed to use ansi characters only you can;
Dim buff() As String
buff = Split(StrConv(my_string, vbUnicode), Chr$(0))
ReDim Preserve buff(UBound(buff) - 1)
You can just assign the string to a byte array (the reverse is also possible). The result is 2 numbers for each character, so Xmas converts to a byte array containing {88,0,109,0,97,0,115,0} or you can use StrConv
Dim bytes() as Byte
bytes = StrConv("Xmas", vbFromUnicode)
which will give you {88,109,97,115} but in that case you cannot assign the byte array back to a string. You can convert the numbers in the byte array back to characters using the Chr() function
Here's another way to do it in VBA.
Function ConvertToArray(ByVal value As String)
value = StrConv(value, vbUnicode)
ConvertToArray = Split(Left(value, Len(value) - 1), vbNullChar)
End Function
Sub example()
Dim originalString As String
originalString = "hi there"
Dim myArray() As String
myArray = ConvertToArray(originalString)
End Sub
According to this code golfing solution by Gaffi, the following works:
a = Split(StrConv(s, 64), Chr(0))
the problem is that there is no built in method (or at least none of us could find one) to do this in vb. However, there is one to split a string on the spaces, so I just rebuild the string and added in spaces....
Private Function characterArray(ByVal my_string As String) As String()
'create a temporary string to store a new string of the same characters with spaces
Dim tempString As String = ""
'cycle through the characters and rebuild my_string as a string with spaces
'and assign the result to tempString.
For Each c In my_string
tempString &= c & " "
Next
'return return tempString as a character array.
Return tempString.Split()
End Function
To split a string into an array of sub-strings of any desired length:
Function charSplitMulti(s As Variant, splitLen As Long) As Variant
Dim padding As Long: padding = 0
Dim l As Long: l = 0
Dim v As Variant
'Pad the string so it divides evenly by
' the length of the desired sub-strings
Do While Len(s) Mod splitLen > 0
s = s & "x"
padding = padding + 1
Loop
'Create an array with sufficient
' elements to hold all the sub-strings
Do Until Len(v) = (Len(s) / splitLen) - 1
v = v & ","
Loop
v = Split(v, ",")
'Populate the array by repeatedly
' adding in the first [splitLen]
' characters of the string, then
' removing them from the string
Do While Not s Like ""
v(l) = Mid(s, 1, splitLen)
s = Right(s, Len(s) - splitLen)
l = l + 1
Loop
'Remove any padding characters added at step one
v(UBound(v)) = Left(v(UBound(v)), Len(v(UBound(v))) - padding)
'Output the array
charSplitMulti = v
End Function
You can pass the string into it either as a string:
Sub test_charSplitMulti_stringInput()
Dim s As String: s = "123456789abc"
Dim subStrLen As Long: subStrLen = 4
Dim myArray As Variant
myArray = charSplitMulti(s, subStrLen)
For i = 0 To UBound(myArray)
MsgBox myArray(i)
Next
End Sub
…or already declard as a variant:
Sub test_charSplitMulti_variantInput()
Dim s As Variant: s = "123456789abc"
Dim subStrLen As Long: subStrLen = 5
s = charSplitMulti(s, subStrLen)
For i = 0 To UBound(s)
MsgBox s(i)
Next
End Sub
If the length of the desired sub-string doesn't divide equally into the length of the string, the uppermost element of the array will be shorter. (It'll be equal to strLength Mod subStrLength. Which is probably obvious.)
I found that most-often I use it to split a string into single characters, so I added another function, so I can be lazy and not have to pass two variables in that case:
Function charSplit(s As Variant) As Variant
charSplit = charSplitMulti(s, 1)
End Function
Sub test_charSplit()
Dim s As String: s = "123456789abc"
Dim myArray As Variant
myArray = charSplit(s)
For i = 0 To UBound(myArray)
MsgBox myArray(i)
Next
End Sub
Try this minicode From Rara:
Function charSplitMulti(TheString As Variant, SplitLen As Long) As Variant
'Defining a temporary array.
Dim TmpArray() As String
'Checking if the SplitLen is not less than one. if so the function returns the whole string without any changing.
SplitLen = IIf(SplitLen >= 1, SplitLen, Len(TheString))
'Redefining the temporary array as needed.
ReDim TmpArray(Len(TheString) \ SplitLen + IIf(Len(TheString) Mod SplitLen <> 0, 1, 0))
'Splitting the input string.
For i = 1 To UBound(TmpArray)
TmpArray(i) = Mid(TheString, (i - 1) * SplitLen + 1, SplitLen)
Next
'Outputing the result.
charSplitMulti = TmpArray
End Function