Function ChewQuery(QueryList As String)
'This function takes in a string and partitions it into a weight tree
Dim ElementList() As String
ElementList = QueryList.Split(";")
Dim LoadedWeight(ElementList.Length) As WeightElement
For x = 0 To ElementList.Length - 1
'Using this method, in which the front portion of the query is repeatedly removed, allows for a simpler query structure, so that we don't need to partition between the pointers and values
LoadedWeight(x).LowPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).HighPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).TraitPointer = Int(BiteQuery(ElementList(x)))
LoadedWeight(x).Num = Int(BiteQuery(ElementList(x)))
ChewQueryValues(ElementList(x), LoadedWeight(x))
Next
Return LoadedWeight
End Function
Function BiteQuery(ByRef QueryList As String)
Dim Marker As Integer
Dim Bite As String
'This function partitions the input string around the first comma
'It returns the section before the comma, and stores the section behind the comma as the new value for the string
Try
Marker = InStr(QueryList, ",")
Bite = Left(QueryList, Marker - 1)
Marker = Len(QueryList) - Marker
QueryList = Right(QueryList, Marker)
Catch
'This is used in the case that a list without a comma is input
Bite = QueryList
QueryList = ""
End Try
Return Bite
End Function
Sub ChewQueryValues(ByRef QueryList As String, ByRef LoadedWeight As WeightElement)
LoadedWeight.Values = {}
While Len(QueryList) > 0
'This While loop is so that an arbitrary number of values can be inserted
'Because BiteQuery takes in functions by reference, each loop reduces the length of the string until it is empty
ReDim Preserve LoadedWeight.Values(LoadedWeight.Values.Length + 1)
LoadedWeight.Values(LoadedWeight.Values.Length - 1).TraitName = BiteQuery(QueryList)
LoadedWeight.Values(LoadedWeight.Values.Length - 1).TraitNum = Int(BiteQuery(QueryList))
LoadedWeight.Values(LoadedWeight.Values.Length - 1).WeightValue = CDec(BiteQuery(QueryList))
End While
End Sub
This set of functions is exhibiting some sort of undefined/random behavior when run in the following case:
FullToken = Strings.Right(Strings.Left(Query, 10), 5) 'This set of functions will extract the 5 rightmost characters of the 10 leftmost characters. This is equivalent to the 5th to 10th characters, which is where the token is stored
QueryText = Strings.Right(Query, Len(Query) - 11)
ReDim Preserve Weight(Weight.Length + 1)
Weight(Weight.Length - 1).Token = FullToken 'This puts the token in the list
Weight(Weight.Length - 1).Weight = ChewQuery(QueryText) 'This puts the weight in the list
WeightList.Text += vbCrLf + FullToken 'This adds the token to the viewable label
This is causing other important parts of the program to fail, which is not desirable. How do I fix this code so that it performs identically on each run of the program?
Related
I am trying to create an application which will determine whether a string entered by user is a palindrome or not.
Is it possible to do without StrReverse, possibly with for next loop. That's what i have done so far.
Working one, with StrReverse:
Dim userInput As String = Me.txtbx1.Text.Trim.Replace(" ", "")
Dim toBeComparedWith As String = StrReverse(userInput)
Select Case String.Compare(userInput, toBeComparedWith, True)
Case 0
Me.lbl2.Text = "The following string is a palindrom"
Case Else
Me.lbl2.Text = "The following string is not a palindrom"
End Select
Not working one:
Dim input As String = TextBox1.Text.Trim.Replace(" ", "")
Dim pallindromeChecker As String = input
Dim output As String
For counter As Integer = input To pallindromeChecker Step -1
output = pallindromeChecker
Next counter
output = pallindromeChecker
If output = input Then
Me.Label1.Text = "output"
Else
Me.Label1.Text = "hi"
End If
While using string reversal works, it is suboptimal because you're iterating over the string at least 2 full times (as string reversal creates a copy of a string because strings are immutable in .NET) (plus extra iterations for your Trim and Replace calls).
However consider the essential properties of a palindrome: the first half of a string is equal to the second half of the string in reverse.
The optimal algorithm for checking a palindrome needs only iterate through half of the input string - by comparing value[n] with value[length-n] for n = 0 to length/2.
In VB.NET:
Public Shared Function IsPalindrome(value As String) As Boolean
' Input validation.
If value Is Nothing Then Throw New ArgumentNullException("value")
value = value.Replace(" ", "") // Note String.Replace(String,String) runs in O(n) time and if replacement is necessary then O(n) space.
' Shortcut case if the input string is empty.
If value.Length = 0 Then Return False ' or True, depends on your preference
' Only need to iterate until half of the string length.
' Note that integer division results in a truncated value, e.g. (5 / 2 = 2)...
'... so this ignores the middle character if the string is an odd-number of characters long.
Dim max As Integer = value.Length - 1
For i As Integer = 0 To value.Length / 2
If value(i) <> value(max-i) Then
' Shortcut: we can abort on the first mismatched character we encounter, no need to check further.
Return False
End If
Next i
' All "opposite" characters are equal, so return True.
Return True
End Function
What I want to do is replace all 'A' in a string with "Bb". but it will only loop with the original string not on the new string.
for example:
AAA
BbAA
BbBbA
and it stops there because the original string only has a length of 3. it reads only up to the 3rd index and not the rest.
Dim txt As String
txt = output_text.Text
Dim a As String = a_equi.Text
Dim index As Integer = txt.Length - 1
Dim output As String = ""
For i = 0 To index
If (txt(i) = TextBox1.Text) Then
output = txt.Remove(i, 1).Insert(i, a)
txt = output
TextBox2.Text += txt + Environment.NewLine
End If
Next
End Sub
I think this leaves us looking for a String.ReplaceFirst function. Since there isn't one, we can just write that function. Then the code that calls it becomes much more readable because it's quickly apparent what it's doing (from the name of the function.)
Public Function ReplaceFirst(searched As String, target As String, replacement As String) As String
'This input validation is just for completeness.
'It's not strictly necessary.
'If the searched string is "null", throw an exception.
If (searched Is Nothing) Then Throw New ArgumentNullException("searched")
'If the target string is "null", throw an exception.
If (target Is Nothing) Then Throw New ArgumentNullException("target")
'If the searched string doesn't contain the target string at all
'then just return it - were done.
Dim foundIndex As Integer = searched.IndexOf(target)
If (foundIndex = -1) Then Return searched
'Build a new string that replaces the target with the replacement.
Return String.Concat(searched.Substring(0, foundIndex), replacement, _
searched.Substring(foundIndex + target.Length, searched.Length - (foundIndex + target.Length)))
End Function
Notice how when you read the code below, you don't even have to spend a moment trying to figure out what it's doing. It's readable. While the input string contains "A", replace the first "A" with "Bb".
Dim input as string = "AAA"
While input.IndexOf("A") > -1
input = input.ReplaceFirst(input,"A","Bb")
'If you need to capture individual values of "input" as it changes
'add them to a list.
End While
You could optimize or completely replace the function. What matters is that your code is readable, someone can tell what it's doing, and the ReplaceFirst function is testable.
Then, let's say you wanted another function that gave you all of the "versions" of your input string as the target string is replaced:
Public Function GetIterativeReplacements(searched As String, target As String, replacement As String) As List(of string)
Dim output As New List(Of String)
While searched.IndexOf(target) > -1
searched = ReplaceFirst(searched, target, replacement)
output.Add(searched)
End While
Return output
End Function
If you call
dim output as List(of string) = GetIterativeReplacments("AAAA","A","Bb")
It's going to return a list of strings containing
BbAAA, BbBbAA, BbBbBbA, BbBbBbBb
It's almost always good to keep methods short. If they start to get too long, just break them into smaller methods with clear names. That way you're not trying to read and follow and test one big, long function. That's difficult whether or not you're a new programmer. The trick isn't being able to create long, complex functions that we understand because we wrote them - it's creating small, simpler functions that anyone can understand.
Check your comments for a better solution, but for future reference you should use a while loop instead of a for loop if your condition will be changing and you're wanting to take that change into account.
I've made a simple example below to help you understand. If you tried the same with a for loop, you'd only get "one" "two" and "three" printed because the for loop doesn't 'see' that vals was changed
Dim vals As New List(Of String)
vals.Add("one")
vals.Add("two")
vals.Add("three")
Dim i As Integer = 0
While i < vals.Count
Console.WriteLine(vals(i))
If vals(i) = "two" Then
vals.Add("four")
vals.Add("five")
End If
i += 1
End While
If you do want to replace one by one instead of using the Replace function, you could use a while loop to look for the index of your search character/string, and then replace/insert at that index.
Sub Main()
Dim a As String = String.Empty
Dim b As String = String.Empty
Dim c As String = String.Empty
Dim d As Int32 = -1
Console.Write("Whole string: ")
a = Console.ReadLine()
Console.Write("Replace: ")
b = Console.ReadLine()
Console.Write("Replace with: ")
c = Console.ReadLine()
d = a.IndexOf(b)
While d > -1
a = a.Remove(d, b.Length)
a = a.Insert(d, c)
d = a.LastIndexOf(b)
End While
Console.WriteLine("Finished string: " & a)
Console.ReadLine()
End Sub
Output would look like this:
Whole string: This is A string for replAcing chArActers.
Replace: A
Replace with: Bb
Finished string: This is Bb string for replBbcing chBbrBbcters.
I was going to write a while loop to answer your question, but realized (with assistance from others) that you could just .replace(x,y)
Output.Text = Input.Text.Replace("A", "Bb")
'Input = N A T O
'Output = N Bb T O
Edit: There is probably a better alternative, but i quickly jotted this loop down, hope it helps.
You've said your new and don't fully understand while loops. So if you don't understand functions either or how to pass arguments to them, I'd suggest looking that up too.
This is your Event, It can be a Button click or Textbox text change.
'Cut & Paste into an Event (Change textboxes to whatever you have input/output)
Dim Input As String = textbox1.Text
Do While Input.Contains("A")
Input = ChangeString(Input, "A", "Bb")
' Do whatever you like with each return of ChangeString() here
Loop
textbox2.Text = Input
This is your Function, with 3 Arguments and a Return Value that can be called in your code
' Cut & Paste into Code somewhere (not inside another sub/Function)
Private Function ChangeString(Input As String, LookFor As Char, ReplaceWith As String)
Dim Output As String = Nothing
Dim cFlag As Boolean = False
For i As Integer = 0 To Input.Length - 1
Dim c As Char = Input(i)
If (c = LookFor) AndAlso (cFlag = False) Then
Output += ReplaceWith
cFlag = True
Else
Output += c
End If
Next
Console.WriteLine("Output: " & Output)
Return Output
End Function
I am learning VB scripting and i am very much new to this concept...
Please tell how to writ the below program
Create a function to enter a to z in a dynamic array using redim preserve.
Thanks
Kumar
I happened to already have a snippet to do what you were looking for, so here it is:
Const StartChar = "a"c
Const EndChar = "z"c
Dim converterOp As New Func(Of Char, Integer)(Function(input As Char) Char.ConvertToUtf32(input, 0))
Dim result() As Char = {}
For i = converterOp(StartChar) To converterOp(EndChar)
ReDim Preserve result(UBound(result) + 1)
result(UBound(result)) = CChar(Char.ConvertFromUtf32(i))
Next
Given a starting character and an ending character in a range of characters (in this case "a"c to "z"c), it converts both characters to their Unicode code point values in order to loop numerically from start to end in a For loop. Within each loop iteration, it adds a new array element to the end of the array, converts the current loop index -- which is, again, a Unicode code point somewhere between the start character and the end character -- back to a character, and fills the new array element with that character.
I know you specifically wanted to do it using a ReDim Preserve, but this is a more-efficient way to do it since it's not incurring the overhead of re-dimensioning the array in every loop iteration:
Const StartChar = "a"c
Const EndChar = "z"c
Dim converterOp As New Func(Of Char, Integer)(Function(input As Char) Char.ConvertToUtf32(input, 0))
Dim intStartCodePoint = converterOp(StartChar)
Dim intEndCodePoint = converterOp(EndChar)
Dim result(intEndCodePoint - intStartCodePoint) As Char
Dim arrIndex = 0
For i = intStartCodePoint To intEndCodePoint
result(arrIndex) = CChar(Char.ConvertFromUtf32(i))
arrIndex += 1
Next
The difference here is that it dimensions the array before entering the loop, using the start and end code points to calculate the size of the array.
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.
I'm trying to make a slot machine program. This procedure that I'm trying to do will assign a name to 3 randomly generated numbers. For some reason I'm getting a conversion error saying that it cant convert the integer to a string. I tried cstr() as well but the problem persisted
Sub GenerateNumbers()
Dim numbers(2) As Integer
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
For x = 0 To 2
numbers(x) = names(CInt(Int((6 * Rnd()) + 1)))
Next x
End Sub
gives me error: conversion from string "Oranges" to type 'Integer' is not valid
The problem is that you are getting a random string from the names array and trying to assign it to numbers, which is declared as an array of integers. Of course this is not gonna work.
Apart from that, there is also the issue with out of bounds index as Eric pointed out.
Edit in response to comments:
To get the text values of those randomly generated slot machine results you just need to declare the array to store results as strings, same way as names is declared.
To be able to get the results from a separate procedure, you need to change it from Sub to Function, which is a procedure that can return a value, an array of strings in this case. Then you can call this function from your Main or any other procedure and store the returned value in a variable.
I also corrected the part with random result generation.
Module SlotMachine
Sub Main()
Dim slotResults As String()
'Get the results
slotResults = GenerateResults()
'Some further processing of results here, e.g. print results to console
For Each item In slotResults
Console.WriteLine(item)
Next
'Wait for keypress before closing the console window
Console.ReadLine()
End Sub
'Generates random results
Function GenerateResults() As String()
Dim results(2) As String
Dim names(5) As String
Dim x As Integer
names(0) = "Cherries"
names(1) = "Oranges"
names(2) = "Plums"
names(3) = "Bells"
names(4) = "Melons"
names(5) = "Bar"
Randomize()
For x = 0 To 2
results(x) = names(Int(6 * Rnd()))
Next x
Return results
End Function
End Module
Int(6 * Rnd()) will get you 0-5, if you +1, then overflow