convert a text to a number - vba

I don't know why this code doesn't work ..i wanna just convert text to number .. It doesn't give me any error but it doesn't work
Public Function ConvertCOMPLEXITYToNumber(ByVal chain As String) As Integer
Select Case chain
Case "1 - Très difficile"
ConvertCOMPLEXITYTToNumber = 1
Case "2 - Difficile"
ConvertCOMPLEXITYTToNumber = 2
Case "3 - Modérée"
ConvertCOMPLEXITYTToNumber = 3
Case "4 - Facile"
ConvertCOMPLEXITYTToNumber = 4
Case Else
ConvertCOMPLEXITYTToNumber = 0
End Select
Exit Function
End Function

That may be because you may have unwanted leading or trailing spaces which fails the comparison. Also you do not need Exit Function at the end of the code. It will exit any ways :)
Try this
Public Function ConvertCOMPLEXITYToNumber(ByVal chain As String) As Integer
Dim Num As Integer
Select Case Trim(chain)
Case "1 - Très difficile": Num = 1
Case "2 - Difficile": Num = 2
Case "3 - Modérée": Num = 3
Case "4 - Facile": Num = 4
Case Else: Num = 0
End Select
ConvertCOMPLEXITYToNumber = Num
End Function

If IsNumeric(Left(Trim(chain),1)) Then
ConvertCOMPLEXITYToNumber = Left(Trim(chain),1)
Else
ConvertCOMPLEXITYToNumber = 0
End If

Here, my approach for you:
Public Function ConvertCOMPLEXITYToNumber(ByVal chain As String) As Integer
'Get the first character
chain = Left(Trim(chain), 1)
'If frist character is numeric
If IsNumeric(chain) Then
'If first number is less than 5, return value
If chain < 5 Then
ConvertCOMPLEXITYToNumber = CInt(chain)
End If
End If
End Function

Related

My vb.NET project input doesn't in my primepairs function . how can I fix them?

Sub PrimePair()
Dim n As Integer
Dim count As Integer = 0
Console.WriteLine(count)
End Sub
Public Function PrimePairs(ByVal n As Integer, ByVal n2 As Long) As Integer
Dim count As Integer = 0
Console.ReadLine()
If n Mod 2 = 0 Then
For i = 1 To (n / 2) + 1
n2 = CLng(n - i)
If IsPrime(CLng(i)) And IsPrime(n2) = True Then
count += 1
End If
Next
Else
n2 = n - 2
If IsPrime(n2) = True Then
count = +1
End If
End If
Console.WriteLine(count)
Return n
End Function
End Module>
I can't run my code without sub. I created two functions, but the inputs I entered do not return in functions and do not print on the screen, I hope I can solve it, thanks for your attention. My project calculates how many different ways it prints the entered input value as a sum of prime numbers. About the Goldbach conjecture

VBA Select case 1 to 100 only taking 1

I'm trying to make a select case that identifies if a number is lower than 0, 1 to 100 or greater than 100, the thing is that is just doesn't work. Here's my code:
If IsNumeric(TxtTemp.Text) Then
Select Case TxtTemp.Text
Case Is <= 0
TxtEstado.Text = "Solid"
Case 1 To 100
TxtEstado.Text = "Liquid"
Case Is > 100
TxtEstado.Text = "Gas"
End Select
Else
TxtEstado.Text = ""
End If
I know that this is an easy thing to do, the thing is that the select case returns liquid only if the number received is equal to 1. If it is lower or equal to 0 it returns solid, but if it is equal or greater to 2, it returns gas. I don't understand what I'm doing wrong.
Maybe it is easier to use a function for this kind of conversion
Function chText(txt As String) As String
On Error GoTo EH
Dim resTxt As String
If IsNumeric(txt) Then
Select Case CDbl(txt)
Case Is <= 0
resTxt = "Solid"
Case 1 To 100
resTxt = "Liquid"
Case Is > 100
resTxt = "Gas"
End Select
Else
resTxt = ""
End If
chText = resTxt
Exit Function
EH:
chText = "Error"
End Function
Sub Tester()
Debug.Print chText("101")
' TxtEstado.Text = chText(TxtTemp.Text)
End Sub

How to compare Strings for Percentage Match using vb.net?

I am banging my head against the wall for a while now trying different techniques.
None of them are working well.
I have two strings.
I need to compare them and get an exact percentage of match,
ie. "four score and seven years ago" TO "for scor and sevn yeres ago"
Well, I first started by comparing every word to every word, tracking every hit, and percentage = count \ numOfWords. Nope, didn't take into account misspelled words.
("four" <> "for" even though it is close)
Then I started by trying to compare every char in each char, incrementing the string char if not a match (to count for misspellings). But, I would get false hits because the first string could have every char in the second but not in the exact order of the second. ("stuff avail" <> "stu vail" (but it would come back as such, low percentage, but a hit. 9 \ 11 = 81%))
SO, I then tried comparing PAIRS of chars in each string. If string1[i] = string2[k] AND string1[i+1] = string2[k+1], increment the count, and increment the "k" when it doesn't match (to track mispellings. "for" and "four" should come back with a 75% hit.) That doesn't seem to work either. It is getting closer, but even with an exact match it is only returns 94%. And then it really gets screwed up when something is really misspelled. (Code at the bottom)
Any ideas or directions to go?
Code
count = 0
j = 0
k = 0
While j < strTempName.Length - 2 And k < strTempFile.Length - 2
' To ignore non letters or digits '
If Not strTempName(j).IsLetter(strTempName(j)) Then
j += 1
End If
' To ignore non letters or digits '
If Not strTempFile(k).IsLetter(strTempFile(k)) Then
k += 1
End If
' compare pair of chars '
While (strTempName(j) <> strTempFile(k) And _
strTempName(j + 1) <> strTempFile(k + 1) And _
k < strTempFile.Length - 2)
k += 1
End While
count += 1
j += 1
k += 1
End While
perc = count / (strTempName.Length - 1)
Edit: I have been doing some research and I think I initially found the code from here and translated it to vbnet years ago. It uses the Levenshtein string matching algorithm.
Here is the code I use for that, hope it helps:
Sub Main()
Dim string1 As String = "four score and seven years ago"
Dim string2 As String = "for scor and sevn yeres ago"
Dim similarity As Single =
GetSimilarity(string1, string2)
' RESULT : 0.8
End Sub
Public Function GetSimilarity(string1 As String, string2 As String) As Single
Dim dis As Single = ComputeDistance(string1, string2)
Dim maxLen As Single = string1.Length
If maxLen < string2.Length Then
maxLen = string2.Length
End If
If maxLen = 0.0F Then
Return 1.0F
Else
Return 1.0F - dis / maxLen
End If
End Function
Private Function ComputeDistance(s As String, t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim distance As Integer(,) = New Integer(n, m) {}
' matrix
Dim cost As Integer = 0
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
'init1
Dim i As Integer = 0
While i <= n
distance(i, 0) = System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
End While
'find min distance
For i = 1 To n
For j = 1 To m
cost = (If(t.Substring(j - 1, 1) = s.Substring(i - 1, 1), 0, 1))
distance(i, j) = Math.Min(distance(i - 1, j) + 1, Math.Min(distance(i, j - 1) + 1, distance(i - 1, j - 1) + cost))
Next
Next
Return distance(n, m)
End Function
Did not work for me unless one (or both) of following are done:
1) use option compare statement "Option Compare Text" before any Import declarations and before Class definition (i.e. the very, very first line)
2) convert both strings to lowercase using .tolower
Xavier's code must be correct to:
While i <= n
distance(i, 0) = System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
End While

Need help converting a number to words

I am trying to convert a number to a word from a RDLC report:
Public Shared Function changeToWords(ByVal numb As [String]) As [String]
Dim val As [String] = ""
Dim wholeNo As [String] = numb
Dim points As [String] = ""
Dim andStr As [String] = ""
Dim pointStr As [String] = ""
Dim endStr As [String] = ""
Try
Dim decimalPlace As Integer = numb.IndexOf(".")
If decimalPlace > 0 Then
wholeNo = numb.Substring(0, decimalPlace)
points = numb.Substring(decimalPlace + 1)
If Convert.ToInt32(points) > 0 Then
andStr = "point"
' just to separate whole numbers from points
pointStr = translateCents(points)
End If
End If
val = [String].Format("{0} {1}{2} {3}", translateWholeNumber(wholeNo).Trim(), andStr, pointStr, endStr)
Catch
End Try
Return val
End Function
Private Shared Function translateWholeNumber(ByVal number As [String]) As [String]
Dim word As String = ""
Try
Dim beginsZero As Boolean = False
'tests for 0XX
Dim isDone As Boolean = False
'test if already translated
Dim dblAmt As Double = (Convert.ToDouble(number))
'if ((dblAmt > 0) && number.StartsWith("0"))
If dblAmt > 0 Then
'test for zero or digit zero in a nuemric
beginsZero = number.StartsWith("0")
Dim numDigits As Integer = number.Length
Dim pos As Integer = 0
'store digit grouping
Dim place As [String] = ""
'digit grouping name:hundres,thousand,etc...
Select Case numDigits
Case 1
'ones' range
word = ones(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
'tens' range
word = tens(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
'hundreds' range
pos = (numDigits Mod 3) + 1
place = " Hundred "
Exit Select
' TODO: might not be correct. Was : Exit Select
'thousands' range
Case 4, 5, 6
pos = (numDigits Mod 4) + 1
place = " Thousand "
Exit Select
' TODO: might not be correct. Was : Exit Select
'millions' range
Case 7, 8, 9
pos = (numDigits Mod 7) + 1
place = " Million "
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 10
'Billions's range
pos = (numDigits Mod 10) + 1
place = " Billion "
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
'add extra case options for anything above Billion...
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = " and " & word.Trim()
End If
End If
'ignore digit grouping names
If word.Trim().Equals(place.Trim()) Then
word = ""
End If
End If
Catch
End Try
Return word.Trim()
End Function
Private Shared Function tens(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = Nothing
Select Case digt
Case 10
name = "Ten"
Exit Select
' TODO: might not be correct. Was : Exit Select \
Case 11
name = "Eleven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 12
name = "Twelve"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 13
name = "Thirteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 14
name = "Fourteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 15
name = "Fifteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 16
name = "Sixteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 17
name = "Seventeen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 18
name = "Eighteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 19
name = "Nineteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 20
name = "Twenty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 30
name = "Thirty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 40
name = "Fourty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 50
name = "Fifty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 60
name = "Sixty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 70
name = "Seventy"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 80
name = "Eighty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 90
name = "Ninety"
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
If digt > 0 Then
name = (Convert.ToString(tens(digit.Substring(0, 1) & "0")) & " ") & Convert.ToString(ones(digit.Substring(1)))
End If
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function ones(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = ""
Select Case digt
Case 1
name = "One"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
name = "Two"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
name = "Three"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 4
name = "Four"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 5
name = "Five"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 6
name = "Six"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 7
name = "Seven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 8
name = "Eight"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 9
name = "Nine"
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function translateCents(ByVal cents As [String]) As [String]
Dim cts As [String] = ""
Dim digit As [String] = ""
Dim engOne As [String] = ""
For i As Integer = 0 To cents.Length - 1
digit = cents(i).ToString()
If digit.Equals("0") Then
engOne = "Zero"
Else
engOne = ones(digit)
End If
cts += " " & engOne
Next
Return cts
End Function
I am getting the wrong output from the conversion.
For 52001 the given output is Fifty Two Thousand and Hundred One.
However, it should be Fifty Two Thousand and One.
You'll need to add a conditional statement to modify your string concatenation behavior when the beginning of your substring is a zero.
'if transalation is not done, continue...(Recursion comes in now!!)
If (number.Substring(0, 1) = "0") Then
word = translateWholeNumber(number.Substring(pos))
Else
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
End If
Edit: Doing this breaks output if the original string sent to changeToWords begins with any zeros. To rectify that condition, you can trim leading zeros, before the string is processed:
Dim wholeNo As [String] = numb.TrimStart("0"c)
Just change this line:
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = translateWholeNumber(number.Substring(0, pos))+ " and " + translateWholeNumber(number.Substring(pos))
End If
End If

Finding Substring of String VB

1.The Following Program will get two inputs from user i.e A & B
2. Than Find the sub string from B.
3. Finally Print the result.
While my code is
Dim a As String
Dim b As String
a = InputBox("Enter First String", a)
b = InputBox("Enter 2nd String", b)
Dim i As Integer
Dim j As Integer = 0
Dim k As Integer = 0
Dim substr As Integer = 0
For i = 0 To a.Length - 1
If a(i) = b(j) Then
j += 1
If b(j) = 0 Then
MsgBox("second string is substring of first one")
substr = 1
Exit For
End If
End If
Next i
For i = 0 To b.Length - 1
If b(i) = a(k) Then
k += 1
If a(k) = 0 Then
MsgBox(" first string is substring of second string")
substr = 1
Exit For
End If
End If
Next i
If substr = 0 Then
MsgBox("no substring present")
End If
End Sub
While compiling it gives following debugging errors.
Line Col
Error 1 Operator '=' is not defined for types 'Char' and 'Integer'. 17 24
Error 2 Operator '=' is not defined for types 'Char' and 'Integer'. 27 24
It is because of these lines:
If b(j) = 0 Then
If a(k) = 0 Then
As a(k) and b(j) are both of the Char data type (think of the string as an array of characters) but you are trying to compare them to an int (0).
If you are looking for a substring and you're using VB.NET you could try using the IndexOf method, for a very naive example:
If a.IndexOf(b) > -1 Then
MsgBox("b is a substring of a")
ElseIf b.IndexOf(a) > -1 Then
MsgBox("a is a substring of b")
Else
MsgBox("No substring found")
End
If you are using VBA, you could also use InStr but I think with this the string is 1-indexed instead of 0-indexed (as they are in VB.NET) so your check may look something like:
If InStr(a,b) > 0 Then
MsgBox("b is a substring of a")
ElseIf InStr(b,a) > 0 Then
MsgBox("a is a substring of b")
Else
MsgBox("No substring found")
End