The following code is excerpted from a larger procedure (the surrounding code is not relevant). Can anyone explain why I am unable to get the second ContainsKey line to return True? Hint: try this on a worksheet with just a few populated cells to reduce looping.
For Each ws As Excel.Worksheet In Wb.Worksheets
Dim dic As New Dictionary(Of Excel.Range, String)
rngUsed = ws.UsedRange
For Each cell As Excel.Range In rngUsed
dic.Add(cell, "test")
'THE FOLLOWING TWO MESSAGES SHOULD DISPLAY THE SAME RESULT, BUT DO NOT. WHY???
MsgBox(dic.ContainsKey(cell)) 'Returns True
MsgBox(dic.ContainsKey(ws.Range(cell.Address))) 'Returns False
Next
Next
UPDATE: I have added the following code and it seems to be working:
Dim dic As New Dictionary(Of Excel.Range, String)(New MyComparer()) 'replaces line from above
Class MyComparer
Implements IEqualityComparer(Of Excel.Range)
Public Function Equals1(ByVal x As Excel.Range, ByVal y As Excel.Range) As Boolean Implements System.Collections.Generic.IEqualityComparer(Of Excel.Range).Equals
If x.Address(External:=True) = y.Address(External:=True) Then
Return True
Else
Return False
End If
End Function
Public Function GetHashCode1(ByVal obj As Excel.Range) As Integer Implements System.Collections.Generic.IEqualityComparer(Of Excel.Range).GetHashCode
Return obj.Count.GetHashCode
End Function
End Class
When an object is used as the key for the dictionary, .Net uses the GetHashCode to generate the key that is used in the underlying hashtable. Since you are using two different objects, you will get different values.
See the MSDN documentation for more details.
A better approach would be to turn the range into a string representation and use that as the key.
Dim dic As New Dictionary(Of Excel.Range, String)(New MyComparer()) 'replaces line from above
Class MyComparer
Implements IEqualityComparer(Of Excel.Range)
Public Function Equals1(ByVal x As Excel.Range, ByVal y As Excel.Range) As Boolean Implements System.Collections.Generic.IEqualityComparer(Of Excel.Range).Equals
If x.Address(External:=True) = y.Address(External:=True) Then
Return True
Else
Return False
End If
End Function
Public Function GetHashCode1(ByVal obj As Excel.Range) As Integer Implements System.Collections.Generic.IEqualityComparer(Of Excel.Range).GetHashCode
Return obj.Count.GetHashCode
End Function
This is the solution. Note that GetHashCode used in this custom comparer is very slow, so if anyone has an idea to speed this up, I'd love to hear it. #competent_tech, I have to use objects for the keys, since there is no string representation for a range that is unique and not subject to change (like how an address changes when adding/deleting rows, for example).
Related
is it possible to pass all elements of an array to a ParamArray?
For example I'd like to pass a ParamArray to another ParamArray:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key 'Run-time error '13' Type mismatch (key is an array)
Next key
End Sub
In this case ParamArray of p2 doesn't contain the elements of keys, but it gets the array-object keys. Thus I've got to check, if an arrays is passed:
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray params() As Variant)
Dim keys As Variant
If IsArray(params(0)) Then
keys = params(0)
Else
keys = params
End If
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
But this is awkward for example compared to Java:
public class VarArgs {
public static void main(String[] args) {
p1("test", "banane", "birne");
p2("test", "banane", "birne");
String[] array = {"test", "banane", "birne"};
p1(array);
p2(array);
}
public static void p1(String... strings) {
p2(strings);
}
public static void p2(String... strings) {
for (String string : strings) {
System.out.println(string);
}
}
}
In Java I don't have to distinguish. But this is probably not possible in VBA.
Thanks for help,
Michael
Pass a ParamArray argument to another function that expects a ParamArray argument (delegate ParamArray arguments).
I need to delegate to a function of type: strf(str as string, ParamArray args() as Variant) as String the arguments received in other function in a ParamArray passing directly without explicitly write.
The restrictions I've found are:
A ParamArray() it can only be passed to another function that expects a ParamArray.
The ParamArray is received at element 0 as a Variant ()
When the second function receives it increases a level of depth
I have not found any satisfactory solution, but I have written a function that works perfectly, undoing the depth levels added and returning a vector with arguments received.
Code:
Option Explicit
Option Base 1
Public Sub PrAr1(ParamArray pa1() As Variant)
Dim arr() As Variant
arr = fn.ParamArrayDelegated(pa1)
PrAr2 pa1
End Sub
Public Sub PrAr2(ParamArray pa2() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa2)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
PrAr3 pa2
End Sub
Public Sub PrAr3(ParamArray pa3() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa3)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
End Sub
Public Function ParamArrayDelegated(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
'When prms(0) is Array, supposed is delegated from another function
arrPrms = prms
Do While VarType(arrPrms(0)) >= vbArray And UBound(arrPrms) < 1
arrWrk = arrPrms(0)
arrPrms = arrWrk
Loop
ParamArrayDelegated = arrPrms
End Function
you could convert it into a Variant from the 2nd call on:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 CVar(keys) '<--| pass it as a Variant
End Sub
Sub p2(keys As Variant) '<--| accept a Variant argument
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
Here's my solution. Note that Its one restriction is that you can pass only one (Variant) array argument to the ParamArray parameter set. Possibly it could be generalized to handle multiple passed arrays but I have yet to run into that need.
Option Explicit
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
Dim TempKeys As Variant
TempKeys = keys 'ParamArray isn't actually a standard Variant array, so you have to copy
'it to one in order for the added test/workaround in p2 to not crash
'Excel.
p2 TempKeys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
If IsArray(keys(0)) Then keys = keys(0) 'Set this routine's ParamArray parameter to be
'the array of its first element.
For Each key In keys
Debug.Print key
Next key
End Sub
Try:
Sub p2(ParamArray keys() As Variant)
dim myKey as Variant
If IsArray(keys(0)) Then
myKey = keys(0)
Else
myKey = keys()
End If
...
end sub
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key(0) '<- Give an Index here.
Next key
End Sub
One of my strongest needs is to be able to take a ParamArray values() As Variant and turned it into a String().
Per the OPs question, I also need to be able to forward other functions to this function, where the other functions have a ParamArray which needs also to be converted to a String() before that function can continue to process.
Here's the solution which includes a robust function to safely return an Array's size:
Public Function f_uas_astrFromParamArray( _
ParamArray pr_avarValues() As Variant _
) As String()
Dim astrResult() As String
Dim avarTemp() As Variant
Dim lngSize As Long
Dim lngUBound As Long
Dim lngIndex As Long
If (IsMissing(pr_avarValues) = False) Then
If (IsArray(pr_avarValues(0)) = True) Then
avarTemp = pr_avarValues(0)
Else
avarTemp = pr_avarValues
End If
lngSize = f_lngArraySize(avarTemp)
If (lngSize > 0) Then
lngUBound = lngSize - 1
ReDim astrResult(0 To lngUBound)
For lngIndex = 0 To lngUBound
astrResult(lngIndex) = CStr(avarTemp(lngIndex))
Next lngIndex
End If
End If
f_uas_astrFromParamArray = astrResult
End Function
'Return Value:
' -1 - Not an Array
' 0 - Empty
' > 0 - Defined
Public Function f_ua_lngArraySize( _
ByRef pr_avarValues As Variant _
, Optional ByVal pv_lngDimensionOneBased As Long = 1 _
) As Long
Dim lngSize As Long: lngSize = -1 'Default to not an Array
Dim lngLBound As Long
Dim lngUBound As Long
On Error GoTo Recovery
If (IsArray(pr_avarValues) = True) Then
lngSize = 0 'Move default to Empty
lngLBound = LBound(pr_avarValues, pv_lngDimensionOneBased)
lngUBound = UBound(pr_avarValues, pv_lngDimensionOneBased)
If (lngLBound <= lngUBound) Then
lngSize = lngUBound - lngLBound + 1 'Non-Empty, so return size
End If
End If
NormalExit:
f_ua_lngArraySize = lngSize
Exit Function
Recovery:
GoTo NormalExit
End Function
In order to pass a ParamArray Variant from function to function called from Excel itself, the unboxing principle showed in previous posts by #JoséIborraBotia was working for a list of ranges,
but
catching the exception raised when trying to unbox one level to much instead of
testing VarType, UBound or IsArray like proposed previously,
allows it to also work for a single range,
witch is critical when passing Excel selections to a custom function.
Let find this unboxing function along with a demonstration of its use to count any combination of Excel cells selection:
ParamArray unboxing function:
Public Function unboxPA(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
Dim done As Boolean
done = False
arrPrms = prms
Do While Not done
On Error Resume Next
arrWrk = arrPrms(0)
If (Err.Number > 0) Then
done = True
End If
arrPrms = arrWrk
Loop
unboxPA = arrPrms
End Function
Unboxing used to count any excel cells selction:
Function MyCountLargeCellsPA(ParamArray rangeArray() As Variant)
Dim unboxed() As Variant
unboxed = unboxPA(rangeArray)
Dim n As Long
For n = LBound(unboxed) To UBound(unboxed)
MyCountLargeCellsPA = MyCountLargeCellsPA + unboxed(n).CountLarge
Next
End Function
This allow any nested call from function to function using ParamArray,
It is now possible to program using VBA !
This will not help the OP anymore since the question has been asked 10 years ago in 2013.
However, if anyone runs into this issue, please do not implement such a horrible stuff blowing up the code logic (and performance) as suggested by most of the answers. Just write clean code to get around that issue.
If you actually want a ParamArray, then do that in the public interface and convert it into an ordinary Array. Let the implementation do the stuff in a straight forward way.
Option Explicit
Public Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
p3 "test", "banane", "birne"
End Sub
'public interface
Public Sub p1(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p1V keys_
End Sub
Public Sub p2(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p2V keys_
End Sub
Public Sub p3(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p3V keys_
End Sub
'private (or even public) implementation
Private Sub p1V(keys() As Variant)
p2V keys
End Sub
Private Sub p2V(keys() As Variant)
p3V keys
End Sub
Private Sub p3V(keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
' "test", "banane", "birne"
' no matter which cascaded function was called
End Sub
paramArrays are weird but you can use normal Array, which works just fine
Sub test()
Dim a As Variant: a = Array("test", "banane", "birne")
p1 a
End Sub
Sub p1(keys As Variant)
p2 keys
End Sub
Sub p2(keys As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
I have a code like below. This is main logic function and I'd like to insert different procedures in that procedure. So is it a way or solution to do that. I marked with **.
Public Shared Sub CheckListSubstrs(ByVal Substrs As IScrNamedObjectList, **mySub(Substr As IScrSubstructure)**)
Dim Substr As IScrSubstructure = Nothing
Dim nSubstr As Integer = Nothing
nSubstr = Substrs.count
If nSubstr > 0 Then
For i As Integer = 0 To nSubstr - 1
Substr = CType(Substrs.item(i), IScrSubstructure)
**mySub(Substr As IScrSubstructure)**
Next
End If
End Sub
I have different types of sub/func procedures and all of them uses Substr As IScr as Substructure as their input so I'd like to insert them dynamically and call them for different classes, modules.
EDIT
I have to clarify my problem more specific to clear conversations.
This is my class with all values.
Option Explicit On
Option Strict On
Imports simpackcomslvLib
Public Class Substr
Public Shared Sub CheckListSubstrs(ByVal Substrs As IScrNamedObjectList, ByVal dgv As DataGridView, SourceType As ****)
Dim nSubstr As Integer = Nothing
nSubstr = Substrs.count
If nSubstr > 0 Then
For i As Integer = 0 To nSubstr - 1
Dim Substr As IScrSubstructure = CType(Substrs.item(i), IScrSubstructure)
'Procedure comes here according to element type for example listing bodies
' CheckListBodies(Substr.getBodyList(False), DataGridView2)
'or if i list forces
'CheckListForces(Substr.getForceList(False), DataGridView3)
'Recursive usage function to get lower substructures information you can think there's a cascaded structure of substructures
CheckListSubstrs(Substrs:=Substr.getSubstrList(False), ProcedureForElementType As ****)
Next
End If
End Sub
Private Shared Sub CheckListBodies(ByVal Bodies As IScrNamedObjectList, ByVal dgv As DataGridView)
Dim nBody As Integer
nBody = Bodies.count
For i As Integer = 0 To nBody - 1
Dim Body As IScrBody = CType(Bodies.item(i), IScrBody)
dgv.Rows.Add(Body.fullName)
Next
End Sub
Private Shared Sub CheckListForces(ByVal Forces As IScrNamedObjectList, ByVal dgv As DataGridView)
Dim nForce As Integer
nForce = Forces.count
For i As Integer = 0 To nForce - 1
Dim Force As IScrForce = CType(Forces.item(i), IScrForce)
dgv.Rows.Add(Force.fullName)
Next
End Sub
Public Shared Sub RunTheCodeforBodies()
CheckListSubstrs(Mdl.getSubstrList(False), DataGridView2, getBodyList)
End Sub
Public Shared Sub RunTheCodeforForces()
CheckListSubstrs(Mdl.getSubstrList(False), DataGridView3, getForceList)
End Sub
End Class
As I showed two examples here, I'm listing different types approx. 30 types. I'm using com-interface and this Iscr types of classes from 3rd part software which I'm connecting.
So all of properties belongs to substructures and I only want to change function element type and output datagridview.
Since you already have existing methods that should elaborate a IScrSubstructure object and, as you say, all methods heve the same signature, you can use a method delegate with that same signature and use it as a parameter of the CheckListSubstrs sub.
A simulation, with some objects that can be used for testing:
Public Structure IScrSubstructure
Public value1 As String
Public value2 As Integer
End Structure
Public Class IScrNamedObjectList
Inherits List(Of IScrSubstructure)
End Class
Public Delegate Sub ScrSubstructureDelegate(ByVal Substr As IScrSubstructure)
Public Shared Sub CheckListSubstrs(ByVal Substrs As IScrNamedObjectList, MyDelegate As ScrSubstructureDelegate)
If Substrs?.Count > 0 Then
For Each item As IScrSubstructure In Substrs
MyDelegate(item)
Next
End If
End Sub
Now, your CheckListSubstrs method has a parameter:
MyDelegate As ScrSubstructureDelegate
you can pass any method that matches that signature:
ByVal Substr As IScrSubstructure
If you try to pass a method that doesn't match the delegate signature, the code will not compile.
So, lets build a couple of methods with these characteristics and call the CheckListSubstrs method using both methods as the MyDelegate parameter:
Public Sub MyIScrSub(ByVal Substr1 As IScrSubstructure)
'Do something with Substr1
Console.WriteLine("MyIScrSub Value1: {0}, MyIScrSub Value2: {1}", Substr1.value1, Substr1.value2)
End Sub
Public Sub MyOtherIScrSub(ByVal AnotherSubscr As IScrSubstructure)
'Do something with AnotherSubscr
Console.WriteLine("MyOtherIScrSub Value1: {0}, MyOtherIScrSub Value2: {1}", AnotherSubscr.value1, AnotherSubscr.value2)
End Sub
Now you can call CheckListSubstrs passing both MyIScrSub and MyOtherIScrSub methods as delegate:
Dim ScrList As IScrNamedObjectList = New IScrNamedObjectList()
ScrList.Add(New IScrSubstructure() With {.value1 = "Value1", .value2 = 1})
ScrList.Add(New IScrSubstructure() With {.value1 = "Value2", .value2 = 2})
ScrList.Add(New IScrSubstructure() With {.value1 = "Value3", .value2 = 3})
CheckListSubstrs(ScrList, AddressOf MyIScrSub)
CheckListSubstrs(ScrList, AddressOf MyOtherIScrSub)
As an note, in the CheckListSubstrs sub I wrote:
If Substrs?.Count > 0 Then
(...)
End If
so you can handle null values for the IScrNamedObjectList parameter:
(this syntax requires VB.Net 14 or newer)
CheckListSubstrs(nothing, AddressOf MyIScrSub)
but you could also write:
If Substrs IsNot Nothing Then
(...)
End If
I'm trying to sum all values of a dictionary(of String, Boolean) as explained in THIS answer but I'm getting error:
Overload resolution failed because no accessible 'Sum' accepts this
number of type arguments
I also tryed on .netFiddle with this:
Imports System.Linq
imports system.collections.generic
Public Module Module1
Public Sub Main()
Dim a as integer
Dim Dic As new dictionary(of string, boolean) _
from {{"First", 0},{"Second",0},{"Third",1}}
a = Dic.values.Sum()
End Sub
End Module
And get same error.
What am I missing?
EDIT:
I know that the code will work if I change my dictionary(of string, boolean) into a dictionary(of string, integer) but I'd like to know if I can use sum() to check boolean values or not.
Sum is not the correct method to use for counting how many entries are true in your dictionary. Sum requires an integer to act on. Your link works correctly because the dictionary has values of type integer, you have a boolean type.
If you want to count how many entries in the dictionary are true then you should use Where to enumerate the entries with True value and then Count the result
Public Sub Main()
Dim a as integer
Dim Dic As new dictionary(of string, boolean) _
from {{"First", 0},{"Second",0},{"Third",1}}
a = Dic.Values.Where(Function(x) x = True).Count()
End Sub
or also
a = Dic.AsEnumerable().Count(Function(x) x.Value = True)
Notice that x = True and x.Value = True are not necessary. Writing x or x.Value is enough. Added here just to clarify the intentions
is it possible to pass all elements of an array to a ParamArray?
For example I'd like to pass a ParamArray to another ParamArray:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key 'Run-time error '13' Type mismatch (key is an array)
Next key
End Sub
In this case ParamArray of p2 doesn't contain the elements of keys, but it gets the array-object keys. Thus I've got to check, if an arrays is passed:
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray params() As Variant)
Dim keys As Variant
If IsArray(params(0)) Then
keys = params(0)
Else
keys = params
End If
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
But this is awkward for example compared to Java:
public class VarArgs {
public static void main(String[] args) {
p1("test", "banane", "birne");
p2("test", "banane", "birne");
String[] array = {"test", "banane", "birne"};
p1(array);
p2(array);
}
public static void p1(String... strings) {
p2(strings);
}
public static void p2(String... strings) {
for (String string : strings) {
System.out.println(string);
}
}
}
In Java I don't have to distinguish. But this is probably not possible in VBA.
Thanks for help,
Michael
Pass a ParamArray argument to another function that expects a ParamArray argument (delegate ParamArray arguments).
I need to delegate to a function of type: strf(str as string, ParamArray args() as Variant) as String the arguments received in other function in a ParamArray passing directly without explicitly write.
The restrictions I've found are:
A ParamArray() it can only be passed to another function that expects a ParamArray.
The ParamArray is received at element 0 as a Variant ()
When the second function receives it increases a level of depth
I have not found any satisfactory solution, but I have written a function that works perfectly, undoing the depth levels added and returning a vector with arguments received.
Code:
Option Explicit
Option Base 1
Public Sub PrAr1(ParamArray pa1() As Variant)
Dim arr() As Variant
arr = fn.ParamArrayDelegated(pa1)
PrAr2 pa1
End Sub
Public Sub PrAr2(ParamArray pa2() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa2)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
PrAr3 pa2
End Sub
Public Sub PrAr3(ParamArray pa3() As Variant)
Dim i As Integer, arrPrms() As Variant
arrPrms = fn.ParamArrayDelegated(pa3)
For i = 0 To UBound(arrPrms)
Debug.Print s.strf("i: %0 prm: %1 ", i, arrPrms(i))
Next i
End Sub
Public Function ParamArrayDelegated(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
'When prms(0) is Array, supposed is delegated from another function
arrPrms = prms
Do While VarType(arrPrms(0)) >= vbArray And UBound(arrPrms) < 1
arrWrk = arrPrms(0)
arrPrms = arrWrk
Loop
ParamArrayDelegated = arrPrms
End Function
you could convert it into a Variant from the 2nd call on:
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 CVar(keys) '<--| pass it as a Variant
End Sub
Sub p2(keys As Variant) '<--| accept a Variant argument
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
Here's my solution. Note that Its one restriction is that you can pass only one (Variant) array argument to the ParamArray parameter set. Possibly it could be generalized to handle multiple passed arrays but I have yet to run into that need.
Option Explicit
Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
Dim TempKeys As Variant
TempKeys = keys 'ParamArray isn't actually a standard Variant array, so you have to copy
'it to one in order for the added test/workaround in p2 to not crash
'Excel.
p2 TempKeys 'should be the same as: p2 "test", "banane", "birne"
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
If IsArray(keys(0)) Then keys = keys(0) 'Set this routine's ParamArray parameter to be
'the array of its first element.
For Each key In keys
Debug.Print key
Next key
End Sub
Try:
Sub p2(ParamArray keys() As Variant)
dim myKey as Variant
If IsArray(keys(0)) Then
myKey = keys(0)
Else
myKey = keys()
End If
...
end sub
Sub test()
p1 "test", "banane", "birne"
End Sub
Sub p1(ParamArray keys() As Variant)
p2 keys
End Sub
Sub p2(ParamArray keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key(0) '<- Give an Index here.
Next key
End Sub
One of my strongest needs is to be able to take a ParamArray values() As Variant and turned it into a String().
Per the OPs question, I also need to be able to forward other functions to this function, where the other functions have a ParamArray which needs also to be converted to a String() before that function can continue to process.
Here's the solution which includes a robust function to safely return an Array's size:
Public Function f_uas_astrFromParamArray( _
ParamArray pr_avarValues() As Variant _
) As String()
Dim astrResult() As String
Dim avarTemp() As Variant
Dim lngSize As Long
Dim lngUBound As Long
Dim lngIndex As Long
If (IsMissing(pr_avarValues) = False) Then
If (IsArray(pr_avarValues(0)) = True) Then
avarTemp = pr_avarValues(0)
Else
avarTemp = pr_avarValues
End If
lngSize = f_lngArraySize(avarTemp)
If (lngSize > 0) Then
lngUBound = lngSize - 1
ReDim astrResult(0 To lngUBound)
For lngIndex = 0 To lngUBound
astrResult(lngIndex) = CStr(avarTemp(lngIndex))
Next lngIndex
End If
End If
f_uas_astrFromParamArray = astrResult
End Function
'Return Value:
' -1 - Not an Array
' 0 - Empty
' > 0 - Defined
Public Function f_ua_lngArraySize( _
ByRef pr_avarValues As Variant _
, Optional ByVal pv_lngDimensionOneBased As Long = 1 _
) As Long
Dim lngSize As Long: lngSize = -1 'Default to not an Array
Dim lngLBound As Long
Dim lngUBound As Long
On Error GoTo Recovery
If (IsArray(pr_avarValues) = True) Then
lngSize = 0 'Move default to Empty
lngLBound = LBound(pr_avarValues, pv_lngDimensionOneBased)
lngUBound = UBound(pr_avarValues, pv_lngDimensionOneBased)
If (lngLBound <= lngUBound) Then
lngSize = lngUBound - lngLBound + 1 'Non-Empty, so return size
End If
End If
NormalExit:
f_ua_lngArraySize = lngSize
Exit Function
Recovery:
GoTo NormalExit
End Function
In order to pass a ParamArray Variant from function to function called from Excel itself, the unboxing principle showed in previous posts by #JoséIborraBotia was working for a list of ranges,
but
catching the exception raised when trying to unbox one level to much instead of
testing VarType, UBound or IsArray like proposed previously,
allows it to also work for a single range,
witch is critical when passing Excel selections to a custom function.
Let find this unboxing function along with a demonstration of its use to count any combination of Excel cells selection:
ParamArray unboxing function:
Public Function unboxPA(ParamArray prms() As Variant) As Variant
Dim arrPrms() As Variant, arrWrk() As Variant
Dim done As Boolean
done = False
arrPrms = prms
Do While Not done
On Error Resume Next
arrWrk = arrPrms(0)
If (Err.Number > 0) Then
done = True
End If
arrPrms = arrWrk
Loop
unboxPA = arrPrms
End Function
Unboxing used to count any excel cells selction:
Function MyCountLargeCellsPA(ParamArray rangeArray() As Variant)
Dim unboxed() As Variant
unboxed = unboxPA(rangeArray)
Dim n As Long
For n = LBound(unboxed) To UBound(unboxed)
MyCountLargeCellsPA = MyCountLargeCellsPA + unboxed(n).CountLarge
Next
End Function
This allow any nested call from function to function using ParamArray,
It is now possible to program using VBA !
This will not help the OP anymore since the question has been asked 10 years ago in 2013.
However, if anyone runs into this issue, please do not implement such a horrible stuff blowing up the code logic (and performance) as suggested by most of the answers. Just write clean code to get around that issue.
If you actually want a ParamArray, then do that in the public interface and convert it into an ordinary Array. Let the implementation do the stuff in a straight forward way.
Option Explicit
Public Sub test()
p1 "test", "banane", "birne"
p2 "test", "banane", "birne"
p3 "test", "banane", "birne"
End Sub
'public interface
Public Sub p1(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p1V keys_
End Sub
Public Sub p2(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p2V keys_
End Sub
Public Sub p3(ParamArray keys() As Variant)
Dim keys_() As Variant: keys_ = keys
p3V keys_
End Sub
'private (or even public) implementation
Private Sub p1V(keys() As Variant)
p2V keys
End Sub
Private Sub p2V(keys() As Variant)
p3V keys
End Sub
Private Sub p3V(keys() As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
' "test", "banane", "birne"
' no matter which cascaded function was called
End Sub
paramArrays are weird but you can use normal Array, which works just fine
Sub test()
Dim a As Variant: a = Array("test", "banane", "birne")
p1 a
End Sub
Sub p1(keys As Variant)
p2 keys
End Sub
Sub p2(keys As Variant)
Dim key As Variant
For Each key In keys
Debug.Print key
Next key
End Sub
I find myself calling functions from lambdas frequently as the provided delegate does not match or does not have sufficient parameters. It is irritating that I cannot do lambda on subroutines. Each time I want to do this I have to wrap my subroutine in a function which returns nothing. Not pretty, but it works.
Is there another way of doing this that makes this smoother/prettier?
I have read that this whole lambda inadequacy will probably be fixed in VS2010/VB10 so my question is more out of curiosity.
A simple Example:
Public Class ProcessingClass
Public Delegate Sub ProcessData(ByVal index As Integer)
Public Function ProcessList(ByVal processData As ProcessData)
' for each in some list processData(index) or whatever'
End Function
End Class
Public Class Main
Private Sub ProcessingSub(ByVal index As Integer, _
ByRef result As Integer)
' (...) My custom processing '
End Sub
Private Function ProcessingFunction(ByVal index As Integer, _
ByRef result As Integer) As Object
ProcessingSub(index, result)
Return Nothing
End Function
Public Sub Main()
Dim processingClass As New ProcessingClass
Dim result As Integer
' The following throws a compiler error as '
' ProcessingSub does not produce a value'
processingClass.ProcessList( _
Function(index As Integer) ProcessingSub(index, result))
' The following is the workaround that'
' I find myself using too frequently.'
processingClass.ProcessList( _
Function(index As Integer) ProcessingFunction(index, result))
End Sub
End Class
If you find that you are doing it too often and generally with the same type of data, you can wrap the delegate in a class.
Create a base class that converts to the delegate:
Public MustInherit Class ProcessDataBase
Public Shared Widening Operator CType(operand As ProcessDataBase) as ProcessingClass.ProcessData
Return AddressOf operand.Process
End Sub
Protected MustOverride Sub Process(index As Integer)
End Class
Inherit from the class:
Public Class ProcessResult
Inherits ProcessDataBase
Public Result As Integer
Protected Overrides Sub Process(index as Integer)
' Your processing, result is modified.
End SUb
End Class
Use it:
Public Class Main()
Public Sub Main()
Dim processingClass As New ProcessingClass
Dim processor As New ProcessResult
processingClass.ProcessList(processor)
Dim result as integer=processor.Result
End Sub
End Class
It IS fixed in VB10, the VS10 Beta is available, if it's an option for you to use it. In VB10 you have lambdas without a return value, and inline subs/functions.
For now, maybe you could just forget lambdas and work with delegates instead? Something like:
processingClass.ProcessList(AddressOf ProcessingSub)