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
Related
I wanted to scrape data from yahoo as an excercise and then make a graph from it. I encountered a problem where when I scrape the dates, they are in a rather weird format:
?10? ?Aug?, ?2020
The question marks in the string are not realy question marks, they are some characters unknown to me, so I cannot remove them with Replace().
Then, when I try to use CDate() to convert this to Date format, the code crashed on "Type mismatch" error.
What I would need is to either find a way to find out what those characters are in order to remove them with Replace(), or to somehow convert even this weird format to a Date.
Alternatively, somehow improving the scraping procedure - so far I've been using for example
ie.document.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(3).innerText
to get the data - would also solve this problem.
If anyone wanted to try to scrape it, too an example url:
https://finance.yahoo.com/quote/LAC/history?period1=1469404800&period2=1627171200&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true
An example of my code follows:
DateString = doc.getElementsByClassName("Py(10px) Ta(start) Pend(10px)")(j).innerText
LeftDateString = Clean_NonPrintableCharacters(DateString)
Worksheets("Stock_data").Range("A2").Value = CDate(LeftDateString)
With regexp:
Function GetDate(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Dim re As New RegExp, retval(0 To 2), patterns, i, result
patterns = Array("\b\d\d\b", "\b[a-zA-Z]+\b", "\b\d{4}\b")
For i = 0 To 2
re.Pattern = patterns(i)
Set result = re.Execute(txt)
If result Is Nothing Then Exit Function 'If no day, month or year is found, GetDate() returns ""
retval(i) = result(0)
Next
GetDate = Join(retval)
End Function
Sub Usage()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?")
Debug.Print GetDate(txt)
Next
End Sub
Prints:
10 Aug 2020
13 Jul 2020
18 March 2021
Edit 2
Function GetDate2(txt)
' set a reference to 'Microsoft VBScript Regular Expression 5.5' in Tools->References VBE menu
Static re As RegExp, months As Collection
Dim result
If re Is Nothing Then 'do it once
Set re = New RegExp
re.Pattern = "[^a-zA-Z0-9]"
re.Global = True
Set months = New Collection
cnt = 1
For Each m In Split("jan,feb,mar,apr,may,jun,jul,aug,sep,oct,nov,dec", ",")
months.Add cnt, m
cnt = cnt + 1
Next
End If
result = Split(WorksheetFunction.Trim(re.Replace(txt, " ")))
For i = 0 To UBound(result)
If Not IsNumeric(result(i)) Then
result(i) = Left(LCase(result(i)), 3)
On Error Resume Next
result(i) = months(result(i))
On Error GoTo 0
End If
Next
result = Join(result)
If IsDate(result) Then GetDate2 = CDate(result)
End Function
Sub Usage2()
For Each txt In Array("?10? ?Aug?, ?2020", "Jul 13, 2020", "2021, March?, 18?", _
"01/12/2021", "04.18.2020", "15 10 20")
Debug.Print GetDate2(txt)
Next
End Sub
Prints:
10.08.2020
13.07.2020
18.03.2021
01.12.2021
18.04.2020
15.10.2020
Note. The order of the dd and mm may be vary
I would use something like so. I've used your ? as question marks for this example, i assumed they were all the same wierd character. This outputs
10 Aug 2020
Sub d()
Dim d As String
d = "?10? ?Aug?, ?2020"
d = Replace(Replace(d, Chr(Asc(Left(d, 1))), vbNullString), ",", vbNullString)
Debug.Print d
End Sub
you could loop though each char in the string and check its ascii values and create your date string from that. Example
Sub GetTheDate(sDate As String)
'97 - 122: lower case Ascii values
Dim i As Integer
Dim strDate As String
'loop through each char
For i = 1 To Len(sDate)
'check to see if it is numeric
If IsNumeric(Mid(sDate, i, 1)) Then
'numeric so add it to the string
strDate = strDate & Mid(sDate, i, 1)
Else
'check to see if it is a char a-z
If Asc(LCase(Mid(sDate, i, 1))) >= 97 And Asc(LCase(Mid(sDate, i, 1))) <= 122 Then
'it is an a char from a-z so add it to string
strDate = strDate & Mid(sDate, i, 1)
Else
'chekc for a space and add a comma - this sets up being able to use cdate()
If Mid(sDate, i, 1) = " " Then
strDate = strDate & ","
End If
End If
End If
Next i
'convert it and print it
Debug.Print CDate(strDate)
End Sub
I have a comment field with cells containing text like this:
Cancelled by user at 2018-01-03 03:11:57 without charge
I want to get the date and time information, but it may not always be in the 3rd/4th from last spaces, otherwise I might try to do some sort of complicated split of the cell. Is there an "in cell" way extract the date time information? Or will this need a VBA script? I prefer the former, but I'm trying to make a macro to simplify my life anyway, so VBA would work too.
I'd propose the following formula:
=MID(A1,FIND("at 20",A1)+3,19)
This would require that the date is always preceded by the word 'at' and the date string starts with 20.
You can try this function. It splits the string checking for items that have the first letter numeric, and builds a result string of just the date information.
Public Function ParseForDate(sCell As String) As String
Dim vSplit As Variant
Dim nIndex As Integer
Dim sResult As String
vSplit = Split(sCell, " ")
For nIndex = 0 To UBound(vSplit)
If IsNumeric(Left$(vSplit(nIndex), 1)) Then
sResult = sResult & vSplit(nIndex) & " "
End If
Next
ParseForDate = Trim$(sResult)
End Function
If you wanted to use it in a formula it would look something like this:
=ParseForDate(A1)
To use it in a VBA routine:
Dim s as String
s = ParseForDate(Range("A1"))
Non-VBA solution: (this is assuming the date format is always the same for all cells)
= MAX(IFERROR(DATEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
+MAX(IFERROR(TIMEVALUE(MID(A1,ROW(INDEX($A:$A,1):INDEX($A:$A,LEN(A1)-19)),20)),0))
Note this is an array formula, so you must press Ctrl+Shift+Enter instead of just Enter when typing this formula.
You will obviously then need to format the cell as a date and time, but this formula gets the numerical value that Excel uses for its internal date and time system.
Using a regex will enable you to fetch the date and time, irrespective of its placement in the string. The following solution will work if the date and time are of the same format as shown in the example string.
Code:
Sub getDateTime()
Dim objReg, matches, str
str = Sheet1.Cells(1, 1).Value 'Change this as per your requirements
Set objReg = CreateObject("vbscript.regexp")
objReg.Global = True
objReg.Pattern = "\d{4}(?:-\d{2}){2}\s*\d{2}(?::\d{2}){2}"
If objReg.test(str) Then
Set matches = objReg.Execute(str)
strResult = matches.Item(0)
MsgBox strResult
End If
End Sub
Click for Regex Demo
Regex Explanation:
\d{4} - matches 4 digits representing the year
(?:-\d{2}){2} - matches - followed by 2 digits. {2} in the end repeats this match 2 times. Once for getting MM and the next time for DD
\s* - matches 0+ whitespaces to match the space between the Date and Time
\d{2} - matches 2 digits representing the HH
(?::\d{2}){2} - matches : followed by 2 digits. The {2} in the end repeats this match 2 times. First time for matching the :MM and the next time for matching the :SS
Screenshots:
Output:
This will be good for about 90 years (using cell C3 for example):
Sub GetDate()
Dim s As String
s = Range("C3").Comment.Text
arr = Split(s, " ")
For i = LBound(arr) To UBound(arr)
If Left(arr(i), 2) = "20" Then
msg = arr(i) & " " & arr(i + 1)
MsgBox msg
Exit Sub
End If
Next i
End Sub
I would like to take the count of character from one position until it reaches a Space Using VBA
Sub testing()
Dim YourText As String
YourText = "my name ismanu prasad"
Cells(1, 1).Value = Len(YourText)
End Sub
Above code will return 21 as output. But my scenario is bit different .I need the count of substring “manu” from the above string and output should be 4
Sub Display4thWord()
Dim Space As String
Dim YourText As String
Dim Begin4thWord As Integer
Dim End4thWord As Integer
YourText = "The first message box display a value"
Space = " "
'Find begin of 4th word.
Begin4thWord = InStr(InStr(InStr(1, YourText, Space, vbBinaryCompare) + 1, YourText, Space, vbBinaryCompare) + 1, YourText, Space, vbBinaryCompare)
'Find end of 4th word/begin of 5th word
End4thWord = InStr(Begin4thWord + 1, YourText, Space, vbBinaryCompare)
MsgBox (Begin4thWord)
'Display 4th word
MsgBox (Mid(YourText, Begin4thWord, End4thWord - Begin4thWord))
End Sub
You need to embed InStr function and use with Mid function.
Is it satisfaction you? This solution have hard code number number of word which it will return.
Declare two variables recordnocount & recordnocount
.position is the value we have
recordnocount = InStr(position + 20, text, " ")
recordnocount1 = recordnocount - (position + 20)
we can get the count .
Thankyou All
I am looking for some code that can search cell by cell in the 2nd column of a table for numbers and decimal points, cut them and paste them in the cell to the left whilst leaving the text behind.
For example:
1(tab space)Test
1.1(tab space)Test
1.1.1(tab space)Test
1.1.1.1(tab space)Test
Where the bullet points represent separate cells in different columns.
In all instances the numbers are separated from the text by a tab space "Chr9" (as indicated in the example)
Any help or useful snippets of code would much appreciated!
EDIT: I have some code that scans each cell in a column but I dont know the code to tell it to only cut numbers and decimal points up to the first tab space.
The Split function delivers what you are after. Sample code:
Dim inputString As String
Dim splitArray() As String
Dim result As String
inputString = "1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then 'Making sure that it found something before using it
result = splitArray(1) 'Text
End If
inputString = "1.1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then
result = splitArray(1) 'Text
End If
'etc.
UPDATE
Code delivering the functionality you want:
Dim splitArray() As String
Dim curTable As Table
Set curTable = ActiveDocument.Tables(1)
For Row = 1 To curTable.Rows.Count
With curTable
splitArray = Split(.Cell(Row, 2).Range.Text, " ")
If (UBound(splitArray) >= 1) Then
.Cell(Row, 2).Range.Text = splitArray(1)
.Cell(Row, 1).Range.Text = splitArray(0)
End If
End With
Next Row
In JAVA or C++, we can do something along the line of myString.insert(position, word). Is there a way we can do the same in Excel VBA's string? In my worksheet, I have a string looks like this: 01 / 01 / 995, I wants to insert a 1 into the year, so make it 01 / 01 / 1995.
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Mid(test_date, 1, 10) & "1" & Mid(test_date, 11, 4)
Is there another easier / more elegant way to do it?
I dont think there is a cleaner way of doing it so you could just wrap it up in a function. Another way of doing it would be with replace, but it's not any cleaner.
Function Insert(source As String, str As String, i As Integer) As String
Insert = Replace(source, tmp, str & Right(source, Len(source)-i))
End Function
or just modify what you have
Function Insert(source As String, str As String, i As Integer) As String
Insert = Mid(source, 1, i) & str & Mid(source, i+1, Len(source)-i)
End Function
This a version of the accepted answer, with added tests and working the way I would expect it to work:
Function Insert(original As String, added As String, pos As Long) As String
If pos < 1 Then pos = 1
If Len(original) < pos Then pos = Len(original) + 1
Insert = Mid(original, 1, pos - 1) _
& added _
& Mid(original, pos, Len(original) - pos + 1)
End Function
The tests pass:
Public Sub TestMe()
Debug.Print Insert("abcd", "ff", 0) = "ffabcd"
Debug.Print Insert("abcd", "ff", 1) = "ffabcd"
Debug.Print Insert("abcd", "ff", 2) = "affbcd"
Debug.Print Insert("abcd", "ff", 3) = "abffcd"
Debug.Print Insert("abcd", "ff", 4) = "abcffd"
Debug.Print Insert("abcd", "ff", 100) = "abcdff"
End Sub
Here is my fifty cents for this question.
First of all, I need to give credit to WONG, Ming Fung from wmfexel where I found this trick.
Unlike the VBA Replace function who asks for the String to replace, the Replace Worksheet function only asks for the position in the Origin String and the number of characters to overwrite.
By "abusing" this overwrite parameter, setting it to 0 allows us to add a given string at a specific position in an Orignin string by replacing 0 characters of it.
Here it how it works :
Dim test_date As String
test_date = "01 / 25 / 995"
test_date = Worksheetfunction.Replace(test_date, 11, 0, "1")
'Now test_date = "01 / 25 / 1995" as we added "1" at the 11th position in it
As you can see, it's really convenient and readable.
For those who are picky and thinks the name Replace is just confusing, Wrap it in an Insert function and you'll be all done ;).