Return dynamic array from function VBA - vba

I am trying to create a function that outputs an array.
However, I got the Function call on left-hand side must return Variant or
Object. How can I return a dynamic array from this function?
Public Function Fibonacci_Array(max As Integer) As Integer
Dim result() As Variant
ReDim result(0 To max)
'' Array indices.
Dim i1 As Integer
Dim i2 As Integer
Dim i As Integer
i1 = 0
i2 = 1
'' Array values.
Dim newVal As Long
Dim prev2 As Long
Dim prev As Long
prev2 = 0
prev = 1
'' Loop through
While prev <= max
result(i1) = prev2
result(i2) = prev
newVal = prev + prev2
''Debug.Print newVal
prev2 = prev
prev = newVal
i1 = i1 + 1
i2 = i2 + 1
Wend
'' Problem here.
Fibonacci_Array() = result
End Function

Variant is the most flexible type when it comes to passing arrays to or from functions.
Replace
Public Function Fibonacci_Array(max As Integer) As Integer
by
Public Function Fibonacci_Array(max As Integer) As Variant
Replace
Dim result() As Variant
by
Dim result As Variant
and replace
Fibonacci_Array() = result
by
Fibonacci_Array = result
That will make it compile, but you seem to need a bit of debugging, since when I then type
?Join(Fibonacci_Array(10),", ")
in the Immediate Window, I get:
0, 1, 1, 2, 3, 5, 8, , , ,
(This might be what you want if you want the Fibonacci numbers which are less than max, but then you might want to use a ReDim Preserve to pare the array down to size before returning it. If your intention was to get the first max Fibonacci numbers, the culprit is the line While prev <= max -- it isn't prev that you would want to compare to max).
On Edit I thought it would be fun to write a VBA function which returns the array of all Fibonacci numbers whose size is <= a given max. Since Fibonacci numbers grow rapidly, I decided to use Long rather than Integer, and also to use Binet's formula to calculate the size of the array (possibly +1 for safety) before filling the array, so we don't allocate an array which is much too large:
Function FibNums(max As Long) As Variant
'returns array consisting of all Fibonacci numbers <= max
'max is assumed to be >= 1
Dim i As Long, n As Long, F As Long
Dim Fibs As Variant
'come up with an upper bound on size of array:
n = 1 + Int(Log(Sqr(5) * max) / Log((1 + Sqr(5)) / 2))
ReDim Fibs(1 To n)
Fibs(1) = 1
Fibs(2) = 1
i = 2
Do While Fibs(i) <= max
F = Fibs(i - 1) + Fibs(i)
If F <= max Then
i = i + 1
Fibs(i) = F
Else
Exit Do 'loop is finished
End If
Loop
'at this stage, Fibs contains i numbers
If i < n Then ReDim Preserve Fibs(1 To i)
FibNums = Fibs
End Function
For example:
?Join(Fibnums(100000),", ")
1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025

Your return type should be the same and you don't need the parenthesis when you assign the value of the function:
Public Function Fibonacci_Array(max As Integer) As Long()
Dim result() As Long
ReDim result(0 To max)
'' Array indices.
Dim i1 As Integer
Dim i2 As Integer
Dim i As Integer
i1 = 0
i2 = 1
'' Array values.
Dim newVal As Long
Dim prev2 As Long
Dim prev As Long
prev2 = 0
prev = 1
'' Loop through
While prev <= max
result(i1) = prev2
result(i2) = prev
newVal = prev + prev2
''Debug.Print newVal
prev2 = prev
prev = newVal
i1 = i1 + 1
i2 = i2 + 1
Wend
'' Problem here.
Fibonacci_Array = result
End Function
Sub a()
Dim b() As Long
b() = Fibonacci_Array(100)
End Sub

Related

Find First and Last Number in a Range of Numbers

Imagine a range of numbers from -133 to +71.
I want to find the first and last numbers in the range that divide by 20: in this case it would be -120 and +60.
I can write a For loop that tests each value and stores the required values:
Dim resultFirst, resultLast As Integer
Dim FirstFound As Boolean = False
For a As Integer = -133 To 71
If a Mod 20 = 0 Then
If FirstFound = False Then
resultFirst = a
FirstFound = True
End If
resultLast = a
End If
Next
but I suspect there is a simpler formula.
You can use Enumerable.Range() and the LINQ-methods Where, Min and Max
Dim resultFirst As Integer
Dim resultLast As Integer
Dim min As Integer = -133
Dim max As Integer = 71
Dim div As Integer = 20
resultFirst = Enumerable.Range(min, max - min + 1).Where(Function(x) x Mod div = 0).Min()
resultLast = Enumerable.Range(min, max - min + 1).Where(Function(x) x Mod div = 0).Max()
Try this one
Dim s As IEnumerable(Of Integer) =
Enumerable.Range(-133, 133 + 72)
Dim minV As Integer = s.AsEnumerable().Where(Function(n) n Mod 20 = 0).Min(Function(n) n)
Dim maxV As Integer = s.AsEnumerable().Where(Function(n) n Mod 20 = 0).Max(Function(n) n)
Console.WriteLine(minV.ToString() & " " & maxV.ToString())
Console.ReadLine()
You can use the following to get the first and last value which is dividable by 20:
Dim fromValue As Integer = -133
Dim first As Integer = (fromValue - (fromValue Mod 20)) + IIf(fromValue > 0 And fromValue Mod 20 <> 0, 20, 0)
Dim toValue As Integer = 71
Dim last As Integer = (toValue - (toValue Mod 20)) - IIf(toValue < 0 And toValue Mod 20 <> 0, 20, 0)
You can also create a function using the above formula:
Private Function GetResult(ByVal fromInt As Integer, ByVal toInt As Integer, ByVal divider As Integer) As Integer()
'set the real from and to value from parameter.
Dim fromValue As Integer = Math.Min(fromInt, toInt)
Dim toValue As Integer = Math.Max(fromInt, toInt)
'get the first and last number dividable by divider between numbers.
Dim first As Integer = (fromValue - (fromValue Mod divider)) + IIf(fromValue > 0 And fromValue Mod divider <> 0, divider, 0)
Dim last As Integer = (toValue - (toValue Mod divider)) - IIf(toValue < 0 And toValue Mod divider <> 0, divider, 0)
If first > toValue Or last < fromValue Then
Return {}
Else
Return {first, last}
End If
End Function
Some test cases for the above function:
GetResult(-133, 71, 20) '0: -120; 1: 60
GetResult(71, -133, 20) '0: -120; 1: 60
GetResult(100, 119, 20) '0: 100; 1: 100
GetResult(-113, -112, 20) 'empty array
GetResult(120, 140, 20) '0: 120; 1: 140

Label a set of objects with (A->Z,AA->ZZ, AAA->ZZZ) in VBA

I have a set which has an unknown number of objects. I want to associate a label to each one of these objects. Instead of labeling each object with a number I want to label them with letters.
For example the first object would be labeled A the second B and so on.
When I get to Z, the next object would be labeled AA
AZ? then BA, BB, BC.
ZZ? then AAA, AAB, AAC and so on.
I'm working using Mapbasic (similar to VBA), but I can't seem to wrap my head around a dynamic solution. My solution assumes that there will be a max number of objects that the set may or may not exceed.
label = pos1 & pos2
Once pos2 reaches ASCII "Z" then pos1 will be "A" and pos2 will be "A". However, if there is another object after "ZZ" this will fail.
How do I overcome this static solution?
Basically what I needed was a Base 26 Counter. The function takes a parameter like "A" or "AAA" and determines the next letter in the sequence.
Function IncrementAlpha(ByVal alpha As String) As String
Dim N As Integer
Dim num As Integer
Dim str As String
Do While Len(alpha)
num = num * 26 + (Asc(alpha) - Asc("A") + 1)
alpha = Mid$(alpha, 2,1)
Loop
N = num + 1
Do While N > 0
str = Chr$(Asc("A") + (N - 1) Mod 26) & str
N = (N - 1) \ 26
Loop
IncrementAlpha = str
End Function
If we need to convert numbers to a "letter format" where:
1 = A
26 = Z
27 = AA
702 = ZZ
703 = AAA etc
...and it needs to be in Excel VBA, then we're in luck. Excel's columns are "numbered" the same way!
Function numToLetters(num As Integer) As String
numToLetters = Split(Cells(1, num).Address(, 0), "$")(0)
End Function
Pass this function a number between 1 and 16384 and it will return a string between A and XFD.
Edit:
I guess I misread; you're not using Excel. If you're using VBA you should still be able to do this will the help of an reference to an Excel Object Library.
This should get you going in terms of the logic. Haven't tested it completely, but you should be able to work from here.
Public Function GenerateLabel(ByVal Number As Long) As String
Const TOKENS As String = "ZABCDEFGHIJKLMNOPQRSTUVWXY"
Dim i As Long
Dim j As Long
Dim Prev As String
j = 1
Prev = ""
Do While Number > 0
i = (Number Mod 26) + 1
GenerateLabel = Prev & Mid(TOKENS, i, 1)
Number = Number - 26
If j > 0 Then Prev = Mid(TOKENS, j + 1, 1)
j = j + Abs(Number Mod 26 = 0)
Loop
End Function

vb.net array.sort() parameters why 1 short?

I'm sorting an array using code like this:
Array.Sort(arr, 0, intEndingPosition, New myIComparer)
I want the sorting to start with index 0 and end with index intEndingPosition. However, the last element arr(intEndingPosition) was left out and did not get sorted. Why?
intEndingPosition is calculated beforehand like this:
Dim StringOfConcern As String
Dim OneChar(65534), FrqOne(65534) As String
Dim CntNewOnes, CntRptOnes As Integer
Dim c As Char
Dim i, j As Integer
Dim isNew As Boolean
StringOfConcern = TextBox1.Text
OneChar(0) = CStr(StringOfConcern(0))
FrqOne(0) = 1
i = 0
j = 0
For Each c In StringOfConcern.Substring(1)
isNew = True
For j = 0 To i Step 1
If CStr(c) = OneChar(j) Then
isNew = False
FrqOne(j) += 1
Exit For
End If
Next j
If isNew = True Then
i += 1
OneChar(i) = CStr(c)
FrqOne(i) = 1
End If
Next c
CntNewOnes = i + 1
CntRptOnes = 0
For i = 0 To CntNewOnes - 1 Step 1
If FrqOne(i) > 1 Then CntRptOnes += 1
Next i
The sorting follows here. The code in my original question is only illustrative. The actual sorting is:
Array.Sort(FrqOne, OneChar, 0, CntNewOnes - 1)
Array.Reverse(FrqOne, 0, CntNewOnes - 1)
Array.Reverse(OneChar, 0, CntNewOnes - 1)
Note the method declaration for Array.Sort
Public Shared Sub Sort (
array As Array,
index As Integer,
length As Integer,
comparer As IComparer
)
The third parameter is the number of elements in the range to sort (length) not the end index as you suggest.
So let's assume for a minute that your intEndingPosition is 4. This means you're expecting to sort 5 elements i.e. elements at indices 0, 1, 2, 3, 4. However, the number 4 is the length and not the end index thus you're only sorting elements at indices 0, 1, 2, 3.
This explains why you're observing that the elements being sorted is one shorter than you expected.
Put it simply the third parameter should specify the length of elements to sort and not the end index.
Another Example:
Consider the Substring method of the String class:
Public Function Substring (
startIndex As Integer,
length As Integer
) As String
Then assume we have this piece of code:
Dim temp As String = "testing"
Dim result As String = temp.Substring(0, 4)
result is now a string containing 4 characters as 4 in the Substring call indicates the length that should be retrieved as opposed to the end index.
Had 4 been the end index then you'd expect result to contain 5 characters.

Get number from Excel column

I'm am using the code example below to represent an integer as an alphabetic string
Private Function GetExcelColumnName(columnNumber As Integer) As String
Dim dividend As Integer = columnNumber
Dim columnName As String = String.Empty
Dim modulo As Integer
While dividend > 0
modulo = (dividend - 1) Mod 26
columnName = Convert.ToChar(65 + modulo).ToString() & columnName
dividend = CInt((dividend - modulo) / 26)
End While
Return columnName
End Function
I found the above example here:
Converting Numbers to Excel Letter Column vb.net
How do I get the reverse, for example:
123 = DS -- Reverse -- DS = 123
35623789 = BYXUWS -- Reverse -- BYXUWS = 35623789
Is it possible to get the number from the alphabetic string without importing Excel?
I found an answer from another post. This function below will work to get the reverse
Public Function GetCol(c As String) As Long
Dim i As Long, t As Long
c = UCase(c)
For i = Len(c) To 1 Step -1
t = t + ((Asc(Mid(c, i, 1)) - 64) * (26 ^ (Len(c) - i)))
Next i
GetCol = t
End Function

VBA sorting a collection by value

I have the VBA collection below
I want to sort by the value such that the collection will end up with the highest double value in the highest index position (i.e. "e" with value 14 is in first index, "c" with value 10 is second, etc). How is this possible?
Public Function SortCollection(ByVal c As Collection) As Collection
Dim n As Long: n = c.Count
If n = 0 Then
Set SortCollection = New Collection
Exit Function
ReDim Index(0 To n - 1) As Long ' allocate index array
Dim i As Long, m As Long
For i = 0 To n - 1: Index(i) = i + 1: Next ' fill index array
For i = n \ 2 - 1 To 0 Step -1 ' generate ordered heap
Heapify c, Index, i, n
Next
For m = n To 2 Step -1 ' sort the index array
Exchange Index, 0, m - 1 ' move highest element to top
Heapify c, Index, 0, m - 1
Next
Dim c2 As New Collection
For i = 0 To n - 1 ' fill output collection
c2.Add c.item(Index(i))
Next
Set SortCollection = c2
End Function
Private Sub Heapify(ByVal c As Collection, Index() As Long, ByVal i1 As Long, ByVal n As Long)
' Heap order rule: a[i] >= a[2*i+1] and a[i] >= a[2*i+2]
Dim nDiv2 As Long: nDiv2 = n \ 2
Dim i As Long: i = i1
Do While i < nDiv2
Dim k As Long: k = 2 * i + 1
If k + 1 < n Then
If c.item(Index(k)) < c.item(Index(k + 1)) Then k = k + 1
End If
If c.item(Index(i)) >= c.item(Index(k)) Then Exit Do
Exchange Index, i, k
i = k
Loop
End Sub
Private Sub Exchange(Index() As Long, ByVal i As Long, ByVal j As Long)
Dim Temp As Long: Temp = Index(i)
Index(i) = Index(j)
Index(j) = Temp
End Sub
As per Domenic in comment and he hasn't answered.
"If you use a Dictionary object instead of a Collection and you can sort by value as shown here. – Domenic Aug 30 at 22:29 "
This works now.