I'm currently working on a program that will convert a string into "combined integer" (namely: from a string, it will be splitted into two characters at a time and then each character in each group will be converted into ASCII number. Then, the first character is multiplied by 256 (shift 8 bit to the left) and add second character. It must not eliminate/forget any character inside the string
Here is when the trouble really begin: it threw IndexOutOfRangeException
Dim input As String = TextBox1.Text.PadLeft(1)
Dim charArr As Char() = input.ToCharArray
Dim intGroup As UShort
Dim strout As String = ""
For index = 0 To charArr.Length - 2 Step 2
Dim i = index
Dim a = charArr(i)
Dim b = charArr(i + 1)
intGroup = CByte(AscW(a)) * 256 + CByte(AscW(b))
strout = strout + CStr(intGroup) + " "
Next
MsgBox(strout)
My guess was that I modify the index inside the loop which is 'forbidden'.
Any possible solution??
Thanks
I would do something like this but I don't know how you want to deal with odd length strings:
For index = 0 To charArr.Length - 1 Step 2
Dim a = charArr(index)
Dim b = If(index=charArr.Length - 1, _
<something to use for odd length strings>, _
charArr(index + 1))
intGroup = CByte(AscW(a)) * 256 + CByte(AscW(b))
strout = strout + CStr(intGroup) + " "
Next
I don't know what you want to use, especially if you bear in mind that .NET strings (unlike, say, C strings) can perfectly well contain a character with ascii code 0, so just using 0 may leave you with ambiguous data, depending on how you're using this string that you're constructing.
But basically, it comes down to you needing to do some special handling for odd length strings, and no magic manipulation of the for loop parameters will avoid that fact - you either deal with them in the loop (as above) or use a shorter loop (.Length - 2) and perform a length check afterwards and deal with the final character that you missed in the loop separately.
For index = 0 To input.Length - 2 step 2
array its zero based, so if the lenght = n, last element is arr[n-1].
for handle only odds element, the last element its arr[n-2].
Related
I have been using some useful VBA code by PEH that uses regular expression to extract the number of instances of a specific element in a chemical formula, see: https://stackoverflow.com/a/46091904/17194644
It works well, but everything slows down when I use the function hundreds of times in one worksheet. I was wondering if this might be due to the time it takes VBA to read/write values from/to the cells, so I created an array function (based on the regex code by PEH) to see if it would speed things up, see below. The function works and is quicker but can still slow things down when dealing with hundreds of values, and I cannot get the second part to work that finds multiplies elements within parenthesis. Any thoughts on how to improve further?
Function CountElements(ChemFormulaRange As Variant, ElementRange As Variant) As Variant
'define variables
Dim RetValRange() As Long
Dim RetVal As Long
Dim ChemFormula As String
Dim npoints As Long
Dim i As Long
Dim mpoints As Long
Dim j As Long
' Convert input ranges to variant arrays
If TypeName(ChemFormulaRange) = "Range" Then ChemFormulaRange = ChemFormulaRange.Value
If TypeName(ElementRange) = "Range" Then ElementRange = ElementRange.Value
'parameter
npoints = UBound(ChemFormulaRange, 1) - LBound(ChemFormulaRange, 1) + 1
mpoints = UBound(ElementRange, 2) - LBound(ElementRange, 2) + 1
'dimension arrays
ReDim RetValRange(1 To npoints, 1 To mpoints)
'calculate all values
For j = 1 To mpoints
Element = ElementRange(1, j)
For i = 1 To npoints
RetVal = 0
ChemFormula = ChemFormulaRange(i, 1)
Call ChemRegex(ChemFormula, Element, RetVal)
RetValRange(i, j) = RetVal
Next i
Next j
'output answer
CountElements = RetValRange
End Function
Private Sub ChemRegex(ChemFormula, Element, RetVal)
Dim regEx As New RegExp
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
'first pattern matches every element once
regEx.Pattern = "([A][cglmrstu]|[B][aehikr]?|[C][adeflmnorsu]?|[D][bsy]|[E][rsu]|[F][elmr]?|[G][ade]|[H][efgos]?|[I][nr]?|[K][r]?|[L][airuv]|[M][cdgnot]|[N][abdehiop]?|[O][gs]?|[P][abdmortu]?|[R][abefghnu]|[S][bcegimnr]?|[T][abcehilms]|[U]|[V]|[W]|[X][e]|[Y][b]?|[Z][nr])([0-9]*)"
Dim Matches As MatchCollection
Set Matches = regEx.Execute(ChemFormula)
Dim m As Match
For Each m In Matches
If m.SubMatches(0) = Element Then
RetVal = RetVal + IIf(Not m.SubMatches(1) = vbNullString, m.SubMatches(1), 1)
End If
Next m
'second patternd finds parenthesis and multiplies elements within
' regEx.Pattern = "(\((.+?)\)([0-9])+)+?"
' Set Matches = regEx.Execute(ChemFormula)
' For Each m In Matches
' RetVal = RetVal + ChemFormula(m.SubMatches(1), Element) * (m.SubMatches(2) - 1) '-1 because all elements were already counted once in the first pattern
' Next m
End Sub
If you are using Office 365, then you do not need VBA. A formula can achieve what you want and I think it would be faster.
=TRIM(TEXTJOIN("",TRUE,IFERROR((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)*1)," ")))
Note: If you still need a VBA solution then remember you can enter the above formula in the entire range in one go and then convert it to values.
rng.Formula = "=TRIM(TEXTJOIN("""",TRUE,IFERROR((MID(A1,ROW(INDIRECT(""1:""&LEN(A1))),1)*1),"" "")))"
rng.Value = rng.Value
The slowest part of your ChemRegex routine is creating the RegExp object.
If all your cells are passed to CountElements as a pair of large areas move the code that creates the RegExp object and applies a few properties from ChemRegex to CountElements, and pass the RegExp reference from CountElements to ChemRegex.
Or, if you are calling CountElements as say a UDF in multiple cells, declare RegExp at module level
Private RegEx as RegExp
In CountElements...
If RegEx is Nothing Then
Set RegEx = New RegExp
' apply the properties
End If
' code
' and pass RegEx to ChemRegex
Call ChemRegex(ChemFormula, Element, RetVal, RegEx)
Isolate all numbers in chemical formula
Just for the sake of the art an alternative to Siddharth 's approach, where I demonstrate how to use Match() comparing
an array of each formula character|digit in the given string with
an array of all regular digits.
This allows to identify array elements (here: digits) based on their position. So this demo might be also helpful to solve similar requirements. - I don't pretend this to be a better or faster way.
Function ChemNo(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
Dim digits
digits = String2Arr("1234567890")
'get any digit position within array digits ' note: zero position returns 10
Dim tmp
tmp = Application.Match(String2Arr(s), digits, 0)
'check for digits in a loop through tmp
Dim i As Long, ii As Long
For i = 1 To UBound(tmp)
If IsNumeric(tmp(i)) Then ' found digit
tmp(i) = tmp(i) Mod 10 ' get digtis including zeros
If IsNumeric(tmp(i - 1)) Then ' check preceding digit
tmp(i) = 10 * tmp(i - 1) + tmp(i) ' complete number
tmp(i - 1) = "!" ' mark former digit
End If
Else
tmp(i) = "!" ' mark non-numeric element
End If
Next i
ChemNo = Filter(tmp, "!", False) ' delete marked elements
End Function
Help function String2Arr()
Assigns an array of single characters after atomizing a string input:
Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
s = StrConv(s, vbUnicode)
String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function
If you want to use the function as tabular input profiting from the newer dynamic features in Excel, you may enter it as user defined function e.g. in cell B1: =ChemNo(A1) displaying each number horizontally in as so called spill range. Using older versions, I suppose you'd need a CSE entry (Ctrl↑┘) to mark it as {array} formula.
I am trying to create a deciphering program which takes the entire English alphabet and shifts the letters' positioning to the left at one increment at a time. I have created a character array for this and I have got the shifting part to work. So, the index of each character in the array changes each time a shift is made. I also created an identical character array which does not shift so it has something to compare to.
Once the shift is made, I have textbox1 output into textbox2 which replaces the letters to their now corresponding letters based on the index of the first character array. For instance, "ABC" is now "DEF". The problem I am having is upon replacing the characters, it will replace them again because their state was changed previously. For example, I changed "A" to "B". Then I move on to changing "B" to "C". But since the "A" was changed to a "B", it is changed again to a "C". I realize doing a For Each Loop caused this to happen so I took it out of a loop and it still does it. I even tried putting a break in the code such as GOTO but that just stops the loop after changing the first letter.
Here is my code:
Private Sub cryptshift()
'SHIFTING ALL CHARACTERS IN ARRAY ONE SPACE TO THE LEFT
Dim temporaryStorageA As [String] = charArray(0)
Dim temporaryStorageB As [String]() = New [String](charArray.Length - 1) {}
For i As Integer = 1 To charArray.Length - 1
temporaryStorageB(i - 1) = charArray(i)
charArray(i - 1) = temporaryStorageB(i - 1)
Next
charArray(charArray.Length - 1) = temporaryStorageA
'CLEARING LABEL54 AND REALIGNING ARRAY TO LABEL53
Label54.Text = Nothing
For Each c In charArray
Label54.Text = Label54.Text & c & "-"
Next
'DECIPHERING
Dim mess As String = TextBox1.Text
Dim result As String = ""
For i As Integer = 0 To mess.Length - 1
Dim c As Char = mess(i)
Dim itemindex As Integer = Array.IndexOf(charArray2, c)
'**This IF Statement allows letters to be deciphered but also allows other characters such as punctuation, numbers and spaces to go through without any altering.**
If charArray2.Contains(c) Then
result &= charArray(itemindex)
Else
result &= c
End If
Next
TextBox2.Text = result
End Sub
Your problem is the .Replace. You should change only the current character. Here, I'm creating a new string with the result.
Dim mess As String = TextBox1.Text
Dim result As String = ""
For i As Integer = 0 To mess.length-1
Dim c As Char = mess(I)
Dim itemindex As Integer = Array.IndexOf(charArray2, c)
result &= charArray(itemindex)
Next
You could then use a string building.
I'm trying to code a program that has two sections depending on which of two buttons has been pressed.
The first section is the bit that is working, the user presses the first button labeled "unsort", this triggers a loop which displays an input box asking for a random number 8 times. These 8 numbers are stored in an array.
However it is the second section I'm struggling with; the second button is labeled sort and should output the numbers the user just entered using the first button is order, smallest to largest. I understand that a bubble sort must be used here and that a loop within a loop must also be used however it is the content of these loop that I don't understand. Since my original post I've edited the post to include some code in the loop I was previously stuck with, however it still isn't producing the desired output (all numbers in order) but is instead just outputting the numbers in a seemingly random order
The code is posted below with annotations:
Public Class BubbleSort1
Dim Bubble(8) As Integer
Dim UnsortedList As String
Dim n As Integer
Dim SortedList As String
Dim temp As String
Private Sub btnUnsort_Click(sender As Object, e As EventArgs) Handles btnUnsort.Click
n = 8 ' number off values on array
For i = 1 To n ' when i is between 1 and size of array
Bubble(i) = InputBox("Enter Number") ' User inputs a number
UnsortedList = UnsortedList & " " & Bubble(i) & vbNewLine ' number is added to the unsorted list variable
Next i
lblUnsort.Text = UnsortedList ' outputs the array
End Sub
Private Sub btnSort_Click(sender As Object, e As EventArgs) Handles btnSort.Click
For i = 1 To n - 1 ' When i is between 1 and the array size - 1 (8-1):
For j = 1 To n - 1 ' Second loop - when j is between 1 and the array size - 1 (8-1):
If Bubble(j) > Bubble(j + 1) Then ' if bubble value j is greater than value j - 1:
temp = Bubble(j)
Bubble(j) = Bubble(j + 1) ' These lines are supost to order the numbers but aren'r currently doing so
Bubble(j + 1) = temp
SortedList = SortedList & Bubble(j) & vbNewLine ' Adding the number in order to a variable
End If
Next j
Next i
lblSort.Text = SortedList ' outputting the ordered numbers
End Sub
End Class
As is pointed out in the code, the section of this code that orders the numbers is just putting them in a random order rather than actually ordering them.
With your updated code which now includes the swapping of array elements, you are building the string which shows the sorted array too soon: it will show the workings rather than the final result.
All you need to do is build the string once the array is in order:
Private Sub btnSort_Click(sender As Object, e As EventArgs) Handles btnSort.Click
' Bubble sort the array...
For i = 1 To n - 1 ' When i is between 1 and the array size - 1 (8-1):
For j = 1 To n - 1 ' Second loop - when j is between 1 and the array size - 1 (8-1):
If Bubble(j) > Bubble(j + 1) Then ' if bubble value j is greater than value j - 1:
temp = Bubble(j)
Bubble(j) = Bubble(j + 1)
Bubble(j + 1) = temp
End If
Next j
Next i
'lblSort.Text = String.Join(vbNewLine, Bubble.Skip(1)) ' an easy one-liner
' Create a string to show the sorted array...
SortedList = "" ' clear it out in case it was used previously
For i = 1 To n
SortedList = SortedList & Bubble(i).ToString()
If i < n Then ' only add a newline if it isn't the last element
SortedList = SortedList & vbNewLine
End If
Next
lblSort.Text = SortedList
End Sub
I put the .ToString() in there in anticipation of you explicitly converting the input strings into numbers; strictly speaking, the & operator will convert its arguments into strings but I prefer to make it obvious in the code.
As your code is, there is an implicit conversion from the input (a string of digits) into an integer (the type of the array elements). While this seems convenient, it can be a problem if VB guesses the wrong conversion for you. There is a way to tell it to let you know if the types of variables don't match: put Option Strict On as the very first line and it will even give you suggestions on what needs to be done to put it right.
If you want to prompt the user for the input, then you will first need to either get a numeric value using a control like a NumericUpDown or you will need to convert the String value to an Integer value using Integer.TryParse. Also, keep in mind that arrays in VB.Net have a 0 based index, so they start at 0, not at 1.
In terms of the Bubble Sort algorithm, you'll need a nested loop like you have with i and j, only your inner-nested loop (j) needs to iterate from the beginning of the array to the second to last item (0 to n-2). Inside of the nested loops, you would compare if the currently iterated value is greater than (or less than depending on which value you want to swap) than the next value. If so, then you'd just reassign the values at the currently iterated index.
Here is a console application example that I whipped up, it does not prompt the user for random values, rather it simply gets a collection of random values and then performs the Bubble Sort:
Private Function BubbleSort(ByVal values() As Integer) As Integer()
'Declare placeholder variables to use in the iterations
Dim temp As Integer
For outterIndex As Integer = 0 To values.Length - 1
For innerIndex As Integer = 0 To values.Length - 2
If values(innerIndex) > values(innerIndex + 1) Then
temp = values(innerIndex + 1)
values(innerIndex + 1) = values(innerIndex)
values(innerIndex) = temp
End If
Next
Next
Return values
End Function
Private r As New Random()
Private Function RandomNumbers(ByVal range As Integer) As Integer()
'Throw an exception if the value is less than 1
If range < 1 Then Throw New ArgumentOutOfRangeException("The range cannot be less than 1")
'Return a collection of random numbers
Return Enumerable.Range(1, range).Select(Function(i) r.Next()).ToArray()
End Function
Fiddle: Live Demo
Short disclaimer: This is my very first question, so please be understanding.
I'm trying to code a function in Excel VBA that takes a binary number (formatted as a string) that counts the spaces, the 0s, and outputs the consecutive amount of 0s (and adds one to it) until the next "1" in that string appears, with "," in between. At the very end of the string, if there's the a "1", the output should look like: "..., 1". I'll try to make a little easier to understand with an example:
Strings of length twelve:
101011010101 --> 2, 2, 1, 2, 2, 2, 1
110000101101 --> 1, 5, 2, 1, 2, 1
100010001000 --> 4, 4, 4
So far I've managed to make a one-dimensional boolean array that takes the string and splits it into parts of length 1, so to say a "binary array". But I couldn't test it, since I only have half of the function.
Function ABSTAND(str As String, size As Integer) As String
Dim i As Integer
Dim arrays(size) As Boolean
For i = 1 To Len(str)
If Mid(str, i, 1) = "1" Then
arrays(i) = True
Else
arrays(i) = False
End If
'Maybe all of this works in a loop?
'Count consecutive 0s, add one
'Output the value with ", " (Concatenate numbers with strings, or make the number a string)
'Count consecutive 0s again
'and so on...
'Add conditions for the last value: Don't add a ", " and check if a one is the last character
End Function
I know, it looks like I have already figured out the problem and only need to implement it, but I'm new to VBA and don't know that well how it works and how to fix syntax and other problems.
Also, I would like to have a generalized form of my problem, that works with every string length, if that's possible.
Unfortunately, VBA isn't the best language for dealing with arrays. I've written the function as described but it sounds like, from your description, you might want to remove the check for If Len(arrZeroes(i)) > 0 Then etc. because it looks like you want to return '1' values in those cases.
Have a play around with the 'Split' function to try get a better feel for it and how it relates to your problem.
Function ABSTAND(str As String) As String
Dim arrZeroes() As String
Dim arrResult() As String
Dim i As Integer
'Initialise arrResult dimensions
ReDim arrResult(1 To 1)
'Splits your binary number into an array with each element being zero or more 0's
'(if there are several 1's in a row or a 1 at the start or finish it returns 0-length element for that position)
arrZeroes = Split(str, "1")
'Loop through each element in this new array
For i = LBound(arrZeroes) To UBound(arrZeroes)
'Sets the top element of the result array to this length + 1 then increments the size (like appending to array)
arrResult(UBound(arrResult)) = Len(arrZeroes(i)) + 1
ReDim Preserve arrResult(1 To UBound(arrResult) + 1)
Next i
'The last step on the result array incremented its ubound which is still empty so we remove that
ReDim Preserve arrResult(1 To UBound(arrResult) - 1)
'then return the array joined!
ABSTAND = Join(arrResult, ", ")
End Function
Let me know if anything doesn't make sense!
Edit:
An array is basically like an indexed list of elements of a specified data type. The line Dim arrZeroes() as String is dimming a dynamic array of string elements. The benefit of using a dynamic array is that you can dynamically change the amount of elements in it using Redim. To get around the lack of an 'append' function, what you have to do is redim the array to make it one element bigger then set this new biggest element to your new value.
arrResult(UBound(arrResult)) = Len(arrZeroes(i)) + 1
ReDim Preserve arrResult(1 To UBound(arrResult) + 1)
That's what these lines are doing. What the Split function does is, given a string and a delimiter, cut the string into a load of slices at each occurrence of the delimiter and return the array. For example, Split("11101101", "0") returns {"111", "11", "1"}. Where there are more than one occurrence of the delimiter in sequence, or the delimiter appears at the beginning or end of the string, it outputs a zero-length element, such as Split("101101", "1") returns {, "0", , "0",}. What the function is doing is looking at the length of each of these slices (i.e. consecutive digits that are not the delimiter) and outputting them to a new array.
Remove the # in your code.
It is used for preprocessing directive, and you do not need it.
More about Preprocessing directives:
https://msdn.microsoft.com/VBA/Language-Reference-VBA/articles/ifthenelse-directive
In general, try the following code:
Option Explicit
Public Sub TestMe()
Debug.Print ABSTAND("101011010101", 12)
End Sub
Function ABSTAND(str As String, size As Long) As String
Dim i As Long
Dim arrays() As Variant
Dim strResult As String
ReDim arrays(size)
For i = 1 To Len(str)
If Mid(str, i, 1) = "1" Then
arrays(i) = True
Else
arrays(i) = False
End If
strResult = strResult & arrays(i)
Next i
ABSTAND = strResult
End Function
It would print something like TrueFalseTrueFalseTrueTrue... Then try to build up your solution further.
Just some points:
Pay attention how the Array is created.
Use Long instead of Integer.
You can shorten the ABSTAND function, to the following:
Function ABSTAND(str As String, size As Long) As String
Dim i As Long
Dim arrays() As Variant
Dim strResult As String
ReDim arrays(size)
For i = 1 To Len(str)
arrays(i) = Mid(str, i, 1) = "1"
strResult = strResult & arrays(i)
Next i
ABSTAND = strResult
End Function
So, I've managed to populate an array with the names of directories, what i need to do now is remove certain parts of the directory names. this is what most of my array look like
F:\Users\Killu\AppData\Local\osu!\Songs\82734 Sakakibara Yui - Nyanderful!
what i need to remove is "F:\Users\Killu\AppData\Local\osu!\Songs\" and then everything after the number. so i would just be left with the various number in my array, the numbers do vary in length from 1 to 7 digits
Use split then connect them together again
Dim Result as string
Dim splitdir() as string = Split("F:\Users\Killu\AppData\Local\osu!\Songs\82734 Sakakibara Yui - Nyanderful!", "\")
Dim x as integer
For i as integer = 0 to 99
For j as integer = 0 to 9
If splitdir(i).substring(0,1) = j
x = i
i = 99
End if
Next
Next
For i as integer = x to splitdir.length - 1
Result += splitdir(i)
Next
Or if the numbers are always in the last part of the directory
Dim Result as string
Dim splitdir() as string = Split("F:\Users\Killu\AppData\Local\osu!\Songs\82734 Sakakibara Yui - Nyanderful!", "\")
Dim x as integer
Result = splitdir(splitdir.length - 1)
I was typing this on my ipad so im sorry if i made some typos/mistakes