I'm trying to use a function with multiple outputs (an array and two integers). I thought I had it working but today I am getting an error, "Unable to cast object of type 'System.Object[,]' to type 'System.String[,]'."
The function:
Public Function convArray(ByVal inputArray As String(,)) As (outputArray As String(,), outputRows As Integer, outputCol As Integer)
Dim sColumns As Integer
Dim sRows As Integer
Dim AscArray As Boolean
sRows = inputArray.GetLength(1)
sColumns = inputArray.GetLength(0)
Dim outputArray(sColumns - 1, sRows - 1)
If inputArray(0, 1) > inputArray(0, 2) Then
AscArray = False
Else
AscArray = True
End If
For k As Integer = 0 To sColumns - 1
outputArray(k, 0) = inputArray(k, 0)
Next
For i As Integer = 0 To sColumns - 1
For j As Integer = 1 To sRows - 1
If AscArray Then
outputArray(i, j) = inputArray(i, j)
Else
outputArray(i, j) = inputArray(i, sRows - j)
End If
Next
Next
Return (outputArray, sRows, sColumns)
End Function
The call:
Dim blrArray = convArray(s)
sDRows = blrArray.outputRows
sDColumns = blrArray.outputCol
ReDim sD(sDColumns - 1, sDRows - 1)
sD = blrArray.outputArray
s and sD are arrays defined elsewhere.
I'm getting the error on the "Return" part of the function.
I apologize in advance for my inefficient code, i'm still pretty new at it.
Related
I need some help with this function. I am trying to find the longest common string between 2 strings. Here is the function that I am currently using:
Public Shared Function LCS(str1 As Char(), str2 As Char())
Dim l As Integer(,) = New Integer(str1.Length - 1, str2.Length - 1) {}
Dim lcs__1 As Integer = -1
Dim substr As String = String.Empty
Dim [end] As Integer = -1
For i As Integer = 0 To str1.Length - 1
For j As Integer = 0 To str2.Length - 1
If str1(i) = str2(j) Then
If i = 0 OrElse j = 0 Then
l(i, j) = 1
Else
l(i, j) = l(i - 1, j - 1) + 1
End If
If l(i, j) > lcs__1 Then
lcs__1 = l(i, j)
[end] = i
End If
Else
l(i, j) = 0
End If
Next
Next
For i As Integer = [end] - lcs__1 + 1 To [end]
substr += str1(i)
Next
Return substr
End Function
This works great on strings of up to around 600 words or so. If I try to compare strings with a larger word count than that it starts to throw system.outofmemoryexception. Obviously, this is hitting the memory pretty hard. Is there any way to fine tune this function or is there possibly another way of doing this that is more streamlined?
I am trying to create a UDF within VBA which go through some function syntax and treat it as Text.
The function will look like :
FunctionA( Param1 , Param2 , Param3 , Param 4 )
I am trying to develop a UDF which will pull out the value of the Param based on the position I input into my UDF function.
GetN( FunctionA , 3 ) = "Param3"
GetN FunctionA , 1 ) = "Param1"
Here's my function so far but it's off....
It's behaving like :
GetN( FunctionA , 0 ) = Param2
Here's my function:
Function GetN(sInputString As String, n As Integer) As String
Dim sFindWhat As String
Dim j, FindA, FindB As Integer
Application.Volatile
sFindWhat = ","
FindA = 0
For j = 0 To n
FindA = InStr(FindA + 1, sInputString, sFindWhat)
FindB = InStr(FindA + 1, sInputString, sFindWhat)
If FindB = 0 Then FindB = InStr(FindA + 1, sInputString, ")")
If FindA = 0 Then Exit For
Next
GetN = Trim(Mid(sInputString, FindA + 1, FindB - FindA - 1))
End Function
Thank you for help
Split should work, though to correctly handle the case of nested functions, a preliminary hack is to first replace commas at the top level by a safe delimiter (e.g. [[,]]) and then splitting on that delimiter:
Function GetParameterN(func As String, n As Long) As String
Dim args As Variant
Dim safeArgs As String
Dim c As String
Dim i As Long, pdepth As Long
func = Trim(func)
i = InStr(func, "(")
args = Mid(func, i + 1)
args = Mid(args, 1, Len(args) - 1)
For i = 1 To Len(args)
c = Mid(args, i, 1)
If c = "(" Then
pdepth = pdepth + 1
ElseIf c = ")" Then
pdepth = pdepth - 1
ElseIf c = "," And pdepth = 0 Then
c = "[[,]]"
End If
safeArgs = safeArgs & c
Next i
args = Split(safeArgs, "[[,]]")
GetParameterN = Trim(args(n - 1))
End Function
For example,
Sub test()
Dim i As Long
For i = 1 To 3
Debug.Print GetParameterN("f(x,g(x,y,z),z)", i)
Next i
End Sub
Produces:
x
g(x,y,z)
z
I see no good reason to make this function volatile.
the code to generate no. of arrays from one is working..I'm try to make some change to it like below
Function myarray(ByVal arra1() As Integer, ByVal arran() As Integer, ByVal arrNumber As Integer) As Integer()
arran = arra1.Clone()
For i As Integer = 0 To arra1.Length - 1
If i = (arrNumber - 1) Then ' IF arrNumber is 1 then +1 to index 0, If it is 2 then +1 to index 1
arran(i) = arra1(i) + 1
'If there are two duplicate value make on of them zero at a time
For k = 0 To arran.Length - 1
For j = k + 1 To arran.Length - 1
If arran(k) = arran(j) Then
arran(k) = 0
End If
'make any value great than 11 zero
If arran(i) > 11 Then
arran(i) = 0
End If
Next
Next
Else
arran(i) = arra1(i)
End If
Next
'Print the array
For i = 0 To arran.Length - 1
Console.Write(arran(i) & " ")
Next
Console.WriteLine()
Return arran
End Function
what I really need is to decompose for example {1,4,5,5} to be {1,4,0,5} and then {1,4,5,0} the above code generate only {1,4,0,5}
I haven't tested this, but I believe the following code will do what you want. Based on your comments, I've changed the function to return all resulting arrays as an array of arrays, rather than requiring the index to change as an input and returning one array. I also ignored matches of 0, as the conditions you describe don't seem designed to handle them. Because of it's recursion, I think this approach will successfully handle input such as {3, 3, 3, 3}.
Public Function jaggedArray(ByVal inputArray() As Integer) As Integer()()
If inputArray Is Nothing Then
Return Nothing
Else
Dim resultArrays()(), i, j As Integer
Dim arrayMax As Integer = inputArray.GetUpperBound(0)
If arrayMax = 0 Then 'prevents errors later if only one number passed
ReDim resultArrays(0)
If inputArray(0) > 11 Then
resultArrays(0) = {1}
ElseIf inputArray(0) = 11 Then
resultArrays(0) = {0}
Else
resultArrays(0) = {inputArray(0) + 1}
End If
Return resultArrays
End If
For i = 0 To arrayMax
Dim tempArray() As Integer = inputArray.Clone
For j = 0 To arrayMax
If tempArray(j) > 11 Then
tempArray(j) = 0
End If
Next
If tempArray(i) = 11 Then
tempArray(i) = 0
Else
tempArray(i) += 1
End If
splitArray(resultArrays, tempArray)
Next
Return resultArrays
End If
End Function
Private Sub splitArray(ByRef arrayList()() As Integer, ByVal sourceArray() As Integer)
Dim x, y As Integer 'positions of matching numbers
If isValid(sourceArray, x, y) Then
If arrayList Is Nothing Then
ReDim arrayList(0)
Else
ReDim Preserve arrayList(arrayList.Length)
End If
arrayList(arrayList.GetUpperBound(0)) = sourceArray
Else
Dim xArray(), yArray() As Integer
xArray = sourceArray.Clone
xArray(x) = 0
splitArray(arrayList, xArray)
yArray = sourceArray.Clone
yArray(y) = 0
splitArray(arrayList, yArray)
End If
End Sub
Private Function isValid(ByRef testArray() As Integer, ByRef match1 As Integer, ByRef match2 As Integer) As Boolean
For i As Integer = 0 To testArray.GetUpperBound(0) - 1
If testArray(i) > 11 Then
testArray(i) = 0
End If
For j As Integer = i + 1 To testArray.GetUpperBound(0)
If testArray(j) > 11 Then
testArray(j) = 0
End If
If testArray(i) = testArray(j) AndAlso testArray(i) > 0 Then 'added second test to prevent infinite recursion
match1 = i
match2 = j
Return False
End If
Next
Next
match1 = -1
match2 = -1
Return True
End Function
I have read through the answers here https://stackoverflow.com/a/14332574/44080
I've also tried to produce equivalent VB.net code:
Option Strict ON
Public Function ParseHex(hexString As String) As Byte()
If (hexString.Length And 1) <> 0 Then
Throw New ArgumentException("Input must have even number of characters")
End If
Dim length As Integer = hexString.Length \ 2
Dim ret(length - 1) As Byte
Dim i As Integer = 0
Dim j As Integer = 0
Do While i < length
Dim high As Integer = ParseNybble(hexString.Chars(j))
j += 1
Dim low As Integer = ParseNybble(hexString.Chars(j))
j += 1
ret(i) = CByte((high << 4) Or low)
i += 1
Loop
Return ret
End Function
Private Function ParseNybble(c As Char) As Integer
If c >= "0"C AndAlso c <= "9"C Then
Return c - "0"C
End If
c = ChrW(c And Not &H20)
If c >= "A"C AndAlso c <= "F"C Then
Return c - ("A"C - 10)
End If
Throw New ArgumentException("Invalid nybble: " & c)
End Function
Can we remove the compile errors in ParseNybble without introducing data conversions?
Return c - "0"c Operator '-' is not defined for types 'Char' and 'Char'
c = ChrW(c And Not &H20) Operator 'And' is not defined for types 'Char' and 'Integer'
As it stands, no.
However, you could change ParseNybble to take an integer and pass AscW(hexString.Chars(j)) to it, so that the data conversion takes place outside of ParseNybble.
This solution is much much faster than all the alternative i have tried. And it avoids any ParseNybble lookup.
Function hex2byte(s As String) As Byte()
Dim l = s.Length \ 2
Dim hi, lo As Integer
Dim b(l - 1) As Byte
For i = 0 To l - 1
hi = AscW(s(i + i))
lo = AscW(s(i + i + 1))
hi = (hi And 15) + ((hi And 64) >> 6) * 9
lo = (lo And 15) + ((lo And 64) >> 6) * 9
b(i) = CByte((hi << 4) Or lo)
Next
Return b
End Function
In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.