signed result of Val function in VBA - vba

I use vba in ms access,and found that ,if my parameter greater than 0x8000
less than 0x10000, the result is minus number
eg. Val("&H8000") = -32768 Val("&HFFFF")= -1
how can i get the unsigned number?
thanks!

There's a problem right here:
?TypeName(&HFFFF)
Integer
The Integer type is 16-bit, and 65,535 overflows it. This is probably overkill, but it was fun to write:
Function ConvertHex(ByVal value As String) As Double
If Left(value, 2) = "&H" Then
value = Right(value, Len(value) - 2)
End If
Dim result As Double
Dim i As Integer, j As Integer
For i = Len(value) To 1 Step -1
Dim digit As String
digit = Mid$(value, i, 1)
result = result + (16 ^ j) * Val("&H" & digit)
j = j + 1
Next
ConvertHex = result
End Function
This function iterates each digit starting from the right, computing its value and adding it to the result as it moves to the leftmost digit.
?ConvertHex("&H10")
16
?ConvertHex("&HFF")
255
?ConvertHex("&HFFFF")
65535
?ConvertHex("&HFFFFFFFFFFFFF")
281474976710655
UPDATE
As I suspected, there's a much better way to do this. Credits to #Jonbot for this one:
Function ConvertHex(ByVal value As String) As Currency
Dim result As Currency
result = CCur(value)
If result < 0 Then
'Add two times Int32.MaxValue and another 2 for the overflow
'Because the hex value is apparently parsed as a signed Int64/Int32
result = result + &H7FFFFFFF + &H7FFFFFFF + 2
End If
ConvertHex = result
End Function

Append an ampersand to the hex literal to force conversion to a 32bit integer:
Val("&HFFFF" & "&") == 65535
Val("&H8000&") == +32768

Don't use Val. Use one of the built-in conversion functions instead:
?CCur("&HFFFF")
65535
?CDbl("&HFFFF")
65535
Prefer Currency over Double in this case, to avoid floating-point issues.

Related

Reading only first 1 to 2 integers in a for loop VBA

How do I read the first 1 to 2 integers of a string in a loop? I need to only parse the first integer or the second integer. For example, "8sdr" I only want to parse "8" and then for a "12sdr" I want to parse "12". I need this to be in a loop to be able to continuously parse only the first integers in a string. Thank you!
The following will return any given number of digits from the start of a string:
Function LeadingDigits(text As String, maxDigits As Integer) As String
Dim pos As Integer, c As String
Do Until pos >= maxDigits Or pos >= Len(text)
c = Mid$(text, pos + 1, 1)
If c < "0" Or c > "9" Then Exit Do
pos = pos + 1
Loop
LeadingDigits = Mid$(text, 1, pos)
End Function
Contrary to solutions that rely on IsNumeric() or Val(), this function does not get confused by strings that can be interpreted as numeric, but don't fall into the specification, such as
hexadecimal ("&habc" = 2748)
scientific notation ("3e4" = 30000)
+/- signs at the start of the string
decimal numbers ".5" = 0.5
Only decimal digits 0–9 at the start of the string are accepted.
The function returns a string, not a numeric type (like Integer) so that there can be a separate return value for "nothing found" (the empty string), and so that very long numbers can be returned that would not fit into a numeric data type.
If you need only up to two numbers that occur before a letter I would use RegEx for this:
Public Function FirstTwoNumbersFromStringBeforeLetter(ByVal textNumbers As String) As Long
Dim regEx
Set regEx = CreateObject("vbscript.regexp")
With regEx
.Global = True
.Pattern = "[a-z].*|\D"
FirstTwoNumbersFromStringBeforeLetter = Left(Val(.Replace(textNumbers, vbNullString)), 2)
End With
End Function

vba get random with string as seed

I'm working under MS-Visio 2010 in VBA (not an expert) and I want to generate a random number (several numbers would be even better) based on a string as seed.
I know that Rnd(seed) with seed as a negative number exists. However, I don't know about any random generator with a string as seed. Maybe some kind of hash function with a number as result ?
I'd like something like :
print function("abc")
45
print function("xyz abc-5")
86
print function("abc")
45
with spaces, symbols and numbers support when inside the seed string.
I may see a workaround by converting each character to some ascii number corresponding and somehow using this big number as seed with Rnd but it definitely feels far-fetched. Does anyone knows of a fancier way of doing so ?
Combined these examples
VBA hash string
Convert HEX string to Unsigned INT (VBA)
to:
Function hash4(txt)
' copied from the example
Dim x As Long
Dim mask, i, j, nC, crc As Integer
Dim c As String
crc = &HFFFF
For nC = 1 To Len(txt)
j = Asc(Mid(txt, nC)) ' <<<<<<< new line of code - makes all the difference
' instead of j = Val("&H" + Mid(txt, nC, 2))
crc = crc Xor j
For j = 1 To 8
mask = 0
If crc / 2 <> Int(crc / 2) Then mask = &HA001
crc = Int(crc / 2) And &H7FFF: crc = crc Xor mask
Next j
Next nC
c = Hex$(crc)
' <<<<< new section: make sure returned string is always 4 characters long >>>>>
' pad to always have length 4:
While Len(c) < 4
c = "0" & c
Wend
Dim Hex2Dbl As Double
Hex2Dbl = CDbl("&h0" & c) ' Overflow Error if more than 2 ^ 64
If Hex2Dbl < 0 Then Hex2Dbl = Hex2Dbl + 4294967296# ' 16 ^ 8 = 4294967296
hash4 = Hex2Dbl
End Function
Try in immediate (Ctrl + G in VBA editor window):
?hash4("Value 1")
31335
?hash4("Value 2")
31527
This function will:
return different number for different input strings
sometimes they will match, it is called hash-collisions
if it is critical, you can use md5, sha-1 hashes, their examples in VBA also available
return same number for same input strings

Add integer to another integer in vb.net?

How can I add an integer to another integer in vb.net?
This is what I need to do:
Given integer: 2187 ->
Converted integer: 2018
I need to add a 0 in between the first and second number, and drop the last digit. This will give me the year.
Here is the code that I have:
Protected Function GetYear(ByVal term As Integer) As Integer
Dim termYear As String = Convert.ToString(term)
termYear.Substring(0, 2)
termYear.Insert(1, "0")
Dim convertedYear As Integer
Int32.TryParse(termYear.ToString, convertedYear)
convertedYear = convertedYear / 10
Return convertedYear
End Function
In general strings are immutable. So you'd have to create a new string out of the addition of substrings. Check this possible solution.
Function GetYear(ByVal term As Integer) As Integer
Dim termYear As String = Convert.ToString(term, Globalization.CultureInfo.InvariantCulture)
Dim result As String = termYear.Substring(0, 1) + "0" + termYear.Substring(1, 2)
Return Int32.Parse(result)
End Function
Strings are immutable, when you do any changes with one of their method, you need to get the returned string.
termYear = termYear.Insert(1, "0")
This question deserves a math based solution. The below code specifies the zero insertion point relative to the number's right side instead of the left as stated in the problem statement. So for a 4 digit number the insertion point is 3 versus 2. It also allows you to change the insertion point.
Private Function GetYear(ByVal term As Integer, Optional zeroDigitPosition As Integer = 3) As Integer
If zeroDigitPosition > 0 Then
Dim divisor As Integer = 1
For i As Integer = 1 To zeroDigitPosition - 1
divisor *= 10
Next
Dim ret As Integer = term \ 10 ' drop one's place digit, remaining digits shift to right
Dim rightShiftedDigits As Integer = ret Mod divisor
Dim remainder As Integer = Math.DivRem(ret, divisor, rightShiftedDigits)
' shift the remainder to the left by divisor * 10
' (remember first right shift invplved \ 10) and add
' rightShiftedDigits to yield result
Return (remainder * divisor * 10) + rightShiftedDigits
Else
Throw New ArgumentOutOfRangeException("zeroDigitPosition must be greater then zero")
End If
End Function

Random number creating

I got some help from one, and the code works perfectly fine.
What im looking for, is an explanation of the code, since my basic VBA-knowledge does not provide me with it.
Can someone explain what happens from "Function" and down?
Sub Opgave8()
For i = 2 To 18288
If Left(Worksheets("arab").Cells(i, 12), 6) = "262015" Then
Worksheets("arab").Cells(i, 3) = "18" & UniqueRandDigits(5)
End If
Next i
End Sub
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
n = Int(Rnd()*10) returns a value between 0 and 9, since Rnd returns a value between 0 and 1 and Int converts it to an integer, aka, a natural number.
Then If InStr(s, n) = 0 checks if the random number is already in your result: if not, it adds it using the string concatenation operator &.
This process loops (do) until i = x + 1 where x is your input argument, so you get a string of length x. Then the first part just fills rows with these random strings.
N.B. : I explained using the logical order of the code. Your friend function UniqRandDigits is defined after the "business logic", but it's the root of the code.
The code loops from row 2 to 18288 in Worksheet "arab". If first 6 characters in 12th column are "262015", then in 3rd column macro will fill cell with value "18" followed by result of function UniqueRandDigits(5) which generates 5 unique digits (0-9).
About the UniqueRandDigits function, the most important is that Rnd() returns a value lesser than 1 but greater than or equal to zero.
Int returns integer value, so Int(Rnd() * 10) will generate a random integer number from 0 to 9.
If InStr(s, n) = 0 Then makes sure than generated integer value doesn't exist in already generated digits of this number, because as the function name says, they must be unique.

Shift letters to the end of a string Visual Basic

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)