I am trying to write a VBA code ; I have 3-days experience as vba programmer. So trying my best based on my pascal programming experience.
find number in hexadecimal string from excel, check the position of number if its odd then replace the number with new number. If its not odd then continue searching for other occurrence within the same string.
I have 15,000 hexa strings where I need to recursively search. range(B1:B15000)
Example:
Hexa string - Cell B1 - 53706167686574746920616c6c9261676c696f2c206f6c696f20652070657065726f63696e692537
translates to text - Spaghetti all�aglio, olio e peperocini
i want to replace 92(�) with 65(e) but in hexa string you notice there are multiple occurrences of 92 number but only one 92 falls at odd position to be replaced.
In excel I tried following:
=IF(ISODD(IF(ISERROR(SEARCH(92,B5)),0,SEARCH(92,B5)))=TRUE,SUBSTITUTE(B5,92,"27"),"no 92")
This works only for first occurrence in cell,
tried modifying it to search further but no luck:
=IF(ISODD(IF(ISERROR(SEARCH(92,B6)),0,SEARCH(92,B6)))=TRUE,SUBSTITUTE(B6,92,"27"),IF(ISODD(IF(ISERROR(SEARCH(92,B6,SEARCH(92,B6)+1)),0,SEARCH(92,B6,SEARCH(92,B6)+1)))=TRUE,SUBSTITUTE(B6,92,"27"),"no 92"))
Any suggestions are welcome.
How about a small UDF, looking only at every second position?
Function replaceWhenAtOddPos(ByVal s As String, findStr As String, replaceStr As String)
replaceWhenAtOddPos = s
If Len(findStr) <> 2 Or Len(replaceStr) <> 2 Then Exit Function
Dim i As Long
For i = 1 To Len(s) Step 2
If Mid(s, i, 2) = findStr Then s = Left(s, i - 1) & replaceStr & Mid(s, i + 2)
Next i
replaceWhenAtOddPos = s
End function
call:
replaceWhenAtOddPos("53706167686574746920616c6c9261676c696f2c206f6c696f20652070657065726f63696e692537", "92", "65")
Please put the following UDF in a standard module:
Public Function replace_hex(str As String, srch As Integer, repl As Integer) As String
Dim pos As Integer
pos = InStr(pos + 1, str, CStr(srch))
Do Until pos = 0
If pos Mod 2 = 0 Then str = Left(str, pos - 1) & CStr(repl) & Mid(str, pos + 2)
pos = InStr(pos + 1, str, CStr(srch))
Loop
replace_hex = str
End Function
and call it in your worksheet like that:
=replace_hex(A1,92,65)
Related
I have been using this code as a starting point: https://danwagner.co/how-to-transpose-horizontal-data-to-vertical-data-for-easy-pivot-tables/
One one of my cells Ax (x referring to the number), the content is ABCDEFGHI and I want to substring the cells every 2 characters, and the last set is 3 characters. Final result looks like:
AB CD EF GHI
At line 44, using the variable
varDetails = .Range(.Cells(lngIdx, 1), .Cells(lngIdx, 4))
and think that is where I need to modify the code. I am not fluent enough with VBA and need some help.
To split the data from your string you can use the following code
Sub SplitStringEveryTwoCharacters()
Dim arrayWithValuesByTwo() As String
Dim myString As String
'Just replace with your data
myString = "ABCDEFGHIJKLM"
'Resize
ReDim arrayWithValuesByTwo(Len(myString) - 1)
'For each 2 character in string
For i = 1 To Len(myString) Step 2
'Add in array
If (i <= Len(myString) - 1) Then
arrayWithValuesByTwo(i - 1) = Mid$(myString, i, 2)
End If
If (i = Len(myString)) Then
arrayWithValuesByTwo(i - 1) = Mid$(myString, i, 1)
End If
Next
End Sub
What you need to change
Here I have set my string into a variable with myString = "ABCDEFGHIJKLM" but you can easily change this and take it directly from a cell with something like myString = Range("A5").
You can access you data with arrayWithValuesByTwo(1) for example. Just loop through it to get all of the values.
I am trying to remove the first numbers of a string of characters (remove all numbers until first non-numerical character is reached). Some strings have starting numbers formatted in the form of "14 214" where it should read 14214. This is the special space for separating numbers, and if the string in A1 starts by 14 214 then
ISNUMBER(LEFT(A1,3)*1)=TRUE
So that means that the space is not a problem, I just have to check for the first non-numerical character.
I thought of the following VBA function:
Function RemoveNumbers(Txt As String) As String
i = 1
Do While i < 9
If (IsError(Left(Txt, i) * 1)) = "False" Then
i = i + 1
Else
RemoveNumbers = Right(Txt, Len(Txt) - i)
End If
Loop
End Function
But it returns #VALUE!
Is the function correctly written? Do you have any suggestions?
Thanks
Walk along the string from left to right, looking at each character.
If the char is a space do nothing, if its a number replace it with a space otherwise return the string with leading spaces removed:
Function RemoveNumbers(txt As String) As String
Dim i As Long
For i = 1 To Len(txt)
Select Case Mid$(txt, i, 1)
Case " ":
Case "0" To "9": Mid$(txt, i, 1) = " "
Case Else
Exit For
End Select
Next
RemoveNumbers = LTrim$(txt)
End Function
Good solution from Alex K.
I would just like to add that the basic problem with the original program was that iserror does not catch the number conversion error - as soon as that occurs the whole function exits and you just get a value error because RemoveNumbers is not set. Also the error doesn't occur when you have left(txt,i)="14 ", but only on the next character when you have left(txt,i)="14 2". To make it work you would have to do something like this
Function RemoveNumbers(Txt As String) As String
On Error GoTo Handler
i = 1
Do While i <= Len(Txt)
firstNumber = Left(Txt, i) * 1
i = i + 1
Loop
Handler:
RemoveNumbers = Right(Txt, Len(Txt) - i + 1)
End Function
I'm trying to shift letters to the end of the word. Like the sample output I have in the image.
Using getchar and remove function, I was able to shift 1 letter.
mychar = GetChar(word, 1) 'Get the first character
word = word.Remove(0, 1) 'Remove the first character
input.Text = mychar
word = word & mychar
output.Text = word
This is my code for shifting 1 letter.
I.E. for the word 'Star Wars', it currently shifts 1 letter, and says 'tar WarsS'
How can I make this move 3 characters to the end? Like in the sample image.
intNumChars = input.text
output.text = mid(word,4,len(word)) & left(word,3)
I wanted it to be easy for you to read but you can set the intNumChars variable to the value in your text box and replace the 4 with intNumChars + 1 and the 3 with intNumChars.
The mid() function can return a section of text in the middle of a string mid(string,start,finish). The len() function returns the length of a string so that the code will work on texts that are different lengths. The left function returns characters from the left() of a string.
I hope this is of some help.
You could write a that as a sort of permute, which maps each char-index to a new place in the range [0, textLength[
In order to do that you'll have to write a custom modulus as the Mod operator is more a remainder than a modulus (from a mathematical point of view, regarding how negative are handled)
With that you just need to loop over your string indexes and map each one to it's "offsetted" value modulo the length of the text
' Can be made local to Shift method if needed
Function Modulus(dividend As Integer, divisor As Integer) As Integer
dividend = dividend Mod divisor
Return If(dividend < 0, dividend + divisor, dividend)
End Function
Function Shift(text As String, offset As Integer) As String
' validation omitted
Dim length = text.Length
Dim arr(length - 1) As Char
For i = 0 To length - 1
arr(Modulus(i + offset, length) Mod length) = text(i)
Next
Return new String(arr)
End Function
That way you can easily handle negative values or values greater than the length of the text.
Note, the same thing is possible with a StringBuilder instead of an array ; I'm not sure which one is "better"
Function Shift(text As String, offset As Integer) As String
Dim builder As New StringBuilder(text)
Dim length = text.Length
For i = 0 To length - 1
builder(Modulus(i + offset, length) Mod length) = text(i)
Next
Return builder.ToString
End Function
Using Gordon's code did the trick. The left function visual studio tried to create a stub of the function, so I used the fully qualified function name when calling it. But this worked perfectly.
intNumChars = shiftnumber.Text
output.Text = Mid(word, intNumChars + 1, Len(word)) & Microsoft.VisualBasic.Left(word, intNumChars)
n = 3
output.Text = Right(word, Len(word) - n) & Left(word, n)
I'm working to create an Excel macro using VBA to convert bit strings to numbers. They are not binary numbers, each '1' stands for it's own number.
e.g: 1100000000000000000010001
from the left, the first bit represents "1", the second bit represents "2", third bit represents "0", and so on. The total quantity of bits in each string is 25.
I want VBA to convert it and show results like so: 1, 2, 21, 25.
I tried using Text to Columns but was not successful.
Try something like this:
Sub Execute()
Dim buff() As String
Dim i As Integer, total As Double
buff = Split(StrConv(<theString>, vbUnicode), Chr$(0))
total = 0
For i = 0 To UBound(buff)
Debug.Print (buff(i))
'total = total + buff(i) * ??
Next i
End Sub
Consider:
Public Function BitPicker(sIn As String) As String
For i = 1 To Len(sIn)
If Mid(sIn, i, 1) = 1 Then
BitPicker = BitPicker & i & ","
End If
Next
BitPicker = Mid(BitPicker, 1, Len(BitPicker) - 1)
End Function
Another non-VBA solution, based on the OP' initial approach and with a layout designed to facilitate multiple 'conversions' (ie copy formulae down to suit):
Does this have to be VBA? Give a data setup like this:
The formula in cell B4 and copied down to B33 is:
=IF(ROWS(B$3:B3)>LEN($B$1)-LEN(SUBSTITUTE($B$1,"1","")),"",FIND("#",SUBSTITUTE($B$1,"1","#",ROWS(B$3:B3))))
The formula cells are formatted as General and the the Bit String cell (B1) is formatted as Text.
Try this:
Function ConvertMyRange(Rng As Range) As String
Dim MyString As String
MyString = Rng.Text
Dim OutPutString As String
For i = 1 To Len(MyString)
If Mid(MyString, i, 1) = "1" Then OutPutString = OutPutString & ", " & i
Next i
' Get rid of first ", " that was added in the loop
If Len(OutPutString) > 0 Then
OutPutString = Mid(OutPutString, 2)
End If
ConvertMyRange = OutPutString
End Function
For your input, the output is 1, 2, 21, 25
I have a list of filenames in a spreadsheet in the form of "Smith, J. 010112.pdf". However, they're in the varying formats of "010112.pdf", "01.01.12.pdf", and "1.01.2012.pdf". How could I change these to one format of "010112.pdf"?
Personally I hate using VBA where worksheet functions will work, so I've worked out a way to do this with worksheet functions. Although you could cram this all into one cell, I've broken it out into a lot of independent steps in separate columns so you can see how it's working, step by step.
For simplicity I'm assuming your file name is in A1
B1 =LEN(A1)
determine the length of the filename
C1 =SUBSTITUTE(A1," ","")
replace spaces with nothing
D1 =LEN(C1)
see how long the string is if you replace spaces with nothing
E1 =B1-D1
determine how many spaces there are
F1 =SUBSTITUTE(A1," ",CHAR(8),E1)
replace the last space with a special character that can't occur in a file name
G1 =SEARCH(CHAR(8), F1)
find the special character. Now we know where the last space is
H1 =LEFT(A1,G1-1)
peel off everything before the last space
I1 =MID(A1,G1+1,255)
peel off everything after the last space
J1 =FIND(".",I1)
find the first dot
K1 =FIND(".",I1,J1+1)
find the second dot
L1 =FIND(".",I1,K1+1)
find the third dot
M1 =MID(I1,1,J1-1)
find the first number
N1 =MID(I1,J1+1,K1-J1-1)
find the second number
O1 =MID(I1,K1+1,L1-K1-1)
find the third number
P1 =TEXT(M1,"00")
pad the first number
Q1 =TEXT(N1,"00")
pad the second number
R1 =TEXT(O1,"00")
pad the third number
S1 =IF(ISERR(K1),M1,P1&Q1&R1)
put the numbers together
T1 =H1&" "&S1&".pdf"
put it all together
It's kind of a mess because Excel hasn't added a single new string manipulation function in over 20 years, so things that should be easy (like "find last space") require severe trickery.
Here's a screenshot of a simple four-step method based on Excel commands and formulas, as suggested in a comment to the answered post (with a few changes)...
This function below works. I've assumed that the date is in ddmmyy format, but adjust as appropriate if it's mmddyy -- I can't tell from your example.
Function FormatThis(str As String) As String
Dim strDate As String
Dim iDateStart As Long
Dim iDateEnd As Long
Dim temp As Variant
' Pick out the date part
iDateStart = GetFirstNumPosition(str, False)
iDateEnd = GetFirstNumPosition(str, True)
strDate = Mid(str, iDateStart, iDateEnd - iDateStart + 1)
If InStr(strDate, ".") <> 0 Then
' Deal with the dot delimiters in the date
temp = Split(strDate, ".")
strDate = Format(DateSerial( _
CInt(temp(2)), CInt(temp(1)), CInt(temp(0))), "ddmmyy")
Else
' No dot delimiters... assume date is already formatted as ddmmyy
' Do nothing
End If
' Piece it together
FormatThis = Left(str, iDateStart - 1) _
& strDate & Right(str, Len(str) - iDateEnd)
End Function
This uses the following helper function:
Function GetFirstNumPosition(str As String, startFromRight As Boolean) As Long
Dim i As Long
Dim startIndex As Long
Dim endIndex As Long
Dim indexStep As Integer
If startFromRight Then
startIndex = Len(str)
endIndex = 1
indexStep = -1
Else
startIndex = 1
endIndex = Len(str)
indexStep = 1
End If
For i = startIndex To endIndex Step indexStep
If Mid(str, i, 1) Like "[0-9]" Then
GetFirstNumPosition = i
Exit For
End If
Next i
End Function
To test:
Sub tester()
MsgBox FormatThis("Smith, J. 01.03.12.pdf")
MsgBox FormatThis("Smith, J. 010312.pdf")
MsgBox FormatThis("Smith, J. 1.03.12.pdf")
MsgBox FormatThis("Smith, J. 1.3.12.pdf")
End Sub
They all return "Smith, J. 010312.pdf".
You don't need VBA. Start by replacing the "."s with nothing:
=SUBSTITUTE(A1,".","")
This will change the ".PDF" to "PDF", so let's put that back:
=SUBSTITUTE(SUBSTITUTE(A1,".",""),"pdf",".pdf")
Got awk? Get the data into a text file, and
awk -F'.' '{ if(/[0-9]+\.[0-9]+\.[0-9]+/) printf("%s., %02d%02d%02d.pdf\n", $1, $2, $3, length($4) > 2 ? substr($4,3,2) : $4); else print $0; }' your_text_file
Assuming the data are exactly as what you described, e.g.,
Smith, J. 010112.pdf
Mit, H. 01.02.12.pdf
Excel, M. 8.1.1989.pdf
Lec, X. 06.28.2012.pdf
DISCLAIMER:
As #Jean-FrançoisCorbett has mentioned, this does not work for "Smith, J. 1.01.12.pdf". Instead of reworking this completely, I'd recommend his solution!
Option Explicit
Function ExtractNumerals(Original As String) As String
'Pass everything up to and including ".pdf", then concatenate the result of this function with ".pdf".
'This will not return the ".pdf" if passed, which is generally not my ideal solution, but it's a simpler form that still should get the job done.
'If you have varying extensions, then look at the code of the test sub as a guide for how to compensate for the truncation this function creates.
Dim i As Integer
Dim bFoundFirstNum As Boolean
For i = 1 To Len(Original)
If IsNumeric(Mid(Original, i, 1)) Then
bFoundFirstNum = True
ExtractNumerals = ExtractNumerals & Mid(Original, i, 1)
ElseIf Not bFoundFirstNum Then
ExtractNumerals = ExtractNumerals & Mid(Original, i, 1)
End If
Next i
End Function
I used this as a testcase, which does not correctly cover all your examples:
Sub test()
MsgBox ExtractNumerals("Smith, J. 010112.pdf") & ".pdf"
End Sub