Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Hi guys!
An other question for you. I would like to create a new UDF with VBA which could allow me to determine the rank of a number within an array. I know that Excel already has a function (WorksheetFunction.Rank()) that does that. But this function requires the second argument to be declared as Range. Therefore I cannot use this function in the context of UDFs where I use array variables, because if I use an array as the second argument I get a ByRef error. I do not want to assign my array to a range on the worksheet, but I simply want to use my array as reference for the ranking procedure. How can I re-write the ranking procedure without using the Rank built- in function, so that I can use an array as reference? Thank you very much!!! Antonio. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
a.riva@UCL wrote:
Hi guys! An other question for you. I would like to create a new UDF with VBA which could allow me to determine the rank of a number within an array. I know that Excel already has a function (WorksheetFunction.Rank()) that does that. But this function requires the second argument to be declared as Range. Therefore I cannot use this function in the context of UDFs where I use array variables, because if I use an array as the second argument I get a ByRef error. I do not want to assign my array to a range on the worksheet, but I simply want to use my array as reference for the ranking procedure. How can I re-write the ranking procedure without using the Rank built- in function, so that I can use an array as reference? Thank you very much!!! Antonio. If the functions in the freely downloadable file at http://home.pacbell.net/beban are available to your workbook ArrayCountIf(arr,value,"") + 1 for arr as if sorted descending ArrayCountIf(arr,value,"<") + 1 for arr as if sorted ascending Or, to make it more analogous to the worksheet function RANK in order of parameters Function ArrayRank(varValue, varArray, Optional varOrder = 0) If IsMissing(varOrder) Or varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function I've left the error checking in the function to the reader. Alan Beban |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Alan Beban wrote:
Function ArrayRank(varValue, varArray, Optional varOrder = 0) If IsMissing(varOrder) Or varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function I've left the error checking in the function to the reader. Alan Beban The above first line is silly; just use If varOrder = 0 Then Alan Beban |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Alan Beban wrote:
Function ArrayRank(varValue, varArray, Optional varOrder = 0) If varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function I've left the error checking in the function to the reader. Alan Beban The above function has the limited use sought by the OP's original illustration, i.e., ArrayRank([some number], varArray, Optional varOrder = 0). If one is going to use such a function, it should have the capability of accepting a range or array as the first parameter, in the same way that the array formula version of the RANK function accepts a range. I'll be working on this, along with the associated error checking. Alan Beban |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Thanks Alan.
I'll download the file straight away! And I'll try the code :-) Cheers!!! Antonio. On 17 Oct, 08:49, Alan Beban wrote: Alan Beban wrote: Function ArrayRank(varValue, varArray, Optional varOrder = 0) If varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function I've left the error checking in the function to the reader. Alan Beban The above function has the limited use sought by the OP's original illustration, i.e., ArrayRank([some number], varArray, Optional varOrder = 0). If one is going to use such a function, it should have the capability of accepting a range or array as the first parameter, in the same way that the array formula version of the RANK function accepts a range. I'll be working on this, along with the associated error checking. Alan Beban |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
For the time being the ArrayRank function, for your use, should be
Function ArrayRank(varValue, varArray, Optional varOrder = 0) If Application.IsNA(Application.Match(varValue, varArray, 0)) Then ArrayRank = "#N/A" ElseIf varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function That way ArrayRank will return #N/A if varValue is not in varArray; that's how the RANK function works. And without the additional first two lines, the ArrayRank function would return a rank of 1 for any missing value. Alan Beban a.riva@UCL wrote: Thanks Alan. I'll download the file straight away! And I'll try the code :-) Cheers!!! Antonio. On 17 Oct, 08:49, Alan Beban wrote: Alan Beban wrote: Function ArrayRank(varValue, varArray, Optional varOrder = 0) If varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If End Function I've left the error checking in the function to the reader. Alan Beban The above function has the limited use sought by the OP's original illustration, i.e., ArrayRank([some number], varArray, Optional varOrder = 0). If one is going to use such a function, it should have the capability of accepting a range or array as the first parameter, in the same way that the array formula version of the RANK function accepts a range. I'll be working on this, along with the associated error checking. Alan Beban |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
How can I re-write the ranking procedure without using the Rank built-
in function, so that I can use an array as reference? This general idea uses the Small functon, but Alan may have something more efficient. Change to "Large" if you want descending order. Again, just a general idea. Sub TestIt() Dim sol 'Returns: 5 sol = RankArray(55, Array(11, 55, 33, 22, 66, 44)) End Sub Function RankArray(n, v) Dim j, k Dim Os 'Offset Os = 1 - LBound(v) With WorksheetFunction For j = LBound(v) To UBound(v) k = .Small(v, j + Os) If k = n Then RankArray = j + Os Exit Function End If Next End With RankArray = "#N/A" End Function -- Dana DeLouis "a.riva@UCL" wrote in message ups.com... Hi guys! An other question for you. I would like to create a new UDF with VBA which could allow me to determine the rank of a number within an array. I know that Excel already has a function (WorksheetFunction.Rank()) that does that. But this function requires the second argument to be declared as Range. Therefore I cannot use this function in the context of UDFs where I use array variables, because if I use an array as the second argument I get a ByRef error. I do not want to assign my array to a range on the worksheet, but I simply want to use my array as reference for the ranking procedure. How can I re-write the ranking procedure without using the Rank built- in function, so that I can use an array as reference? Thank you very much!!! Antonio. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
a.riva@UCL wrote:
Thanks Alan. I'll download the file straight away! And I'll try the code :-) Cheers!!! Antonio. Here is a more general function that is intended to mirror with arrays (or ranges, for that matter) the operation of the RANK worksheet function; watch for wordwrap. It depends on other functions in the freely downloadable file at http://home.pacbell.net/beban. Constructive comments welcome. Function ArrayRank(varValue, varArray, Optional varOrder = 0) 'This function is designed to operate on arrays as the 'worksheet RANK function operates on ranges. Dim arrOut, numDimsV As Integer, i As Long, j As Long Dim varArrayDupe, varValueDupe 'Return a single rank for a single variable. If Not IsArray(varValue) Then 'Reject non-numeric input. If Not IsNumeric(varValue) Then Msg = "the first input parameter must be a number" & _ "or a range or array of numbers." MsgBox Msg, 16 Exit Function End If If Application.IsNA(Application.Match(varValue, varArray, 0)) Then ArrayRank = "#N/A" ElseIf varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If Else 'Convert ranges, if any, to arrays varArray = varArray varValue = varValue 'To insure numeric values, convert input to Long() type arrays ReDim varArrayDupe(1) As Long ReDim varValueDupe(1) As Long 'Assign varValue to a Long() type array xV = Assign(varValue, varValueDupe) 'If varValue contains values not convertible to Longs, the 'assignment will fail, so If xV = False Then Exit Function 'Assign varArray to a Long() type array xA = Assign(varArray, varArrayDupe) 'If varArray contains values not convertible to Longs, the 'assignment will fail, so If xA = False Then Exit Function numDimsV = ArrayDimensions(varValueDupe) Select Case numDimsV 'If the input values to be ranked are in a 1-dimensional array, return 'a same sized 1-dimensional array of rank values. Case 1 'Load a 1-dimensional output array. ReDim arrOut(LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1) For i = LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1 If varOrder = 0 Then If IsError(ArrayMatch(varValueDupe(i), varArrayDupe)) Then arrOut(i) = "#N/A" Else arrOut(i) = ArrayCountIf(varArrayDupe, varValueDupe(i), "") + 1 End If Else If IsError(ArrayMatch(varValueDupe(i), varArrayDupe)) Then arrOut(i) = "#N/A" Else arrOut(i) = ArrayCountIf(varArrayDupe, varValueDupe(i), "<") + 1 End If End If i = i + 1 Next 'If the input values to be ranked are in a 2-dimensional array, return 'a same sized 2-dimensional array of rank values. Case 2 'Load a 2-dimensional output array. ReDim arrOut(LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1, _ LBound(varValueDupe, 2) To UBound(varValueDupe, 2) - LBound(varValueDupe, 2) + 1) For i = LBound(varValue) To UBound(varValue) - LBound(varValue) + 1 For j = LBound(varValueDupe, 2) To UBound(varValueDupe, 2) - LBound(varValueDupe, 2) + 1 If varOrder = 0 Then If IsError(ArrayMatch(varValueDupe(i, j), varArrayDupe)) Then arrOut(i, j) = "#N/A" Else arrOut(i, j) = ArrayCountIf(varArrayDupe, varValueDupe(i, j), "") + 1 End If Else If IsError(ArrayMatch(varValueDupe(i, j), varArrayDupe)) Then arrOut(i, j) = "#N/A" Else arrOut(i, j) = ArrayCountIf(varArrayDupe, varValueDupe(i, j), "<") + 1 End If End If Next Next End Select ArrayRank = arrOut End If End Function Alan Beban |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Alan Beban wrote:
a.riva@UCL wrote: Thanks Alan. I'll download the file straight away! And I'll try the code :-) Cheers!!! Antonio. Here is a more general function that is intended to mirror with arrays (or ranges, for that matter) the operation of the RANK worksheet function; watch for wordwrap. It depends on other functions in the freely downloadable file at http://home.pacbell.net/beban. Constructive comments welcome. My previous posting of the general function had a spurious i=i+1 in it; here it is with the correction: Function ArrayRank(varValue, varArray, Optional varOrder = 0) 'This function is designed to operate on arrays as the 'worksheet RANK function operates on ranges. Dim arrOut, numDimsV As Integer, i As Long, j As Long Dim varArrayDupe, varValueDupe 'Return a single rank for a single variable. If Not IsArray(varValue) Then 'Reject non-numeric input. If Not IsNumeric(varValue) Then Msg = "the first input parameter must be a number" & _ "or a range or array of numbers." MsgBox Msg, 16 Exit Function End If If Application.IsNA(Application.Match(varValue, varArray, 0)) Then ArrayRank = "#N/A" ElseIf varOrder = 0 Then ArrayRank = ArrayCountIf(varArray, varValue, "") + 1 Else ArrayRank = ArrayCountIf(varArray, varValue, "<") + 1 End If Else 'Convert ranges, if any, to arrays varArray = varArray varValue = varValue 'To insure numeric values, convert input to Long() type arrays ReDim varArrayDupe(1) As Long ReDim varValueDupe(1) As Long 'Assign varValue to a Long() type array xV = Assign(varValue, varValueDupe) 'If varValue contains values not convertible to Longs, the 'assignment will fail, so If xV = False Then Exit Function 'Assign varArray to a Long() type array xA = Assign(varArray, varArrayDupe) 'If varArray contains values not convertible to Longs, the 'assignment will fail, so If xA = False Then Exit Function numDimsV = ArrayDimensions(varValueDupe) Select Case numDimsV 'If the input values to be ranked are in a 1-dimensional array, return 'a same sized 1-dimensional array of rank values. Case 1 'Load a 1-dimensional output array. ReDim arrOut(LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1) For i = LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1 If varOrder = 0 Then If IsError(ArrayMatch(varValueDupe(i), varArrayDupe)) Then arrOut(i) = "#N/A" Else arrOut(i) = ArrayCountIf(varArrayDupe, varValueDupe(i), "") + 1 End If Else If IsError(ArrayMatch(varValueDupe(i), varArrayDupe)) Then arrOut(i) = "#N/A" Else arrOut(i) = ArrayCountIf(varArrayDupe, varValueDupe(i), "<") + 1 End If End If Next 'If the input values to be ranked are in a 2-dimensional array, return 'a same sized 2-dimensional array of rank values. Case 2 'Load a 2-dimensional output array. ReDim arrOut(LBound(varValueDupe) To UBound(varValueDupe) - LBound(varValueDupe) + 1, _ LBound(varValueDupe, 2) To UBound(varValueDupe, 2) - LBound(varValueDupe, 2) + 1) For i = LBound(varValue) To UBound(varValue) - LBound(varValue) + 1 For j = LBound(varValueDupe, 2) To UBound(varValueDupe, 2) - LBound(varValueDupe, 2) + 1 If varOrder = 0 Then If IsError(ArrayMatch(varValueDupe(i, j), varArrayDupe)) Then arrOut(i, j) = "#N/A" Else arrOut(i, j) = ArrayCountIf(varArrayDupe, varValueDupe(i, j), "") + 1 End If Else If IsError(ArrayMatch(varValueDupe(i, j), varArrayDupe)) Then arrOut(i, j) = "#N/A" Else arrOut(i, j) = ArrayCountIf(varArrayDupe, varValueDupe(i, j), "<") + 1 End If End If Next Next End Select ArrayRank = arrOut End If End Function Alan Beban |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
Thanks for all the suggestions!
The code that Dana sent is working very well, and it's really simple :-) Now I have an other question... I have my usual option-based-1 array1 in VBA, which contains x numbers. Some of them are repeated. What I would like to do is creating an other option-based-1 array, let's call it array2, which contains the numbers of occurrences of each of the repeated elements of array1 within array1... I'm struggling to find a solution... For example: option-based-1 array1 is (1, 2, 4, 6, 5, 4, 7, 2, 3, 2, 3) -- I cannot sort the array. I think that the procedure should do the following operation: it detects how many items are repeated in "array1", and for each of this repeated items stores in a new array "array2" a number corresponding to the number of its occurrences. For example, in array1 the procedure detects that there are n=3 items which occur more than once (they are "2", "4" and "3"). Then it ReDims array2 (1 to n), and for i=1 to n it gives to array2(i) the values of: i=1 -- array2(1) = 3 (occurrences of "2"), i=2 -- array2(2) = 2 (occurrences of "4"), i=3 -- array2(3) = 2 (occurrences of "3"). Can somebody help me? Thanks in advance :-) Antonio. |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Ranking without preset Excel function.
i=1 -- array2(1) = 3 (occurrences of "2"),
i=2 -- array2(2) = 2 (occurrences of "4"), i=3 -- array2(3) = 2 (occurrences of "3"). Hi. One idea is to use a Dictionary Object. Here is a general idea. I understand you only want an array of those items with a count 1. Sub Demo_Tally() Dim d Dim p Dim n, k Dim v v = Array(1, 2, 4, 6, 5, 4, 7, 2, 3, 2, 3) Set d = CreateObject("Scripting.Dictionary") ' Add Key, Item (Both Required) '// Tally items For p = LBound(v) To UBound(v) n = v(p) If d.exists(n) Then d(n) = d(n) + 1 Else d.Add n, 1 End If Next p '// Remove items with Count = 1 For Each k In d.keys If d(k) = 1 Then d.Remove (k) Next k '// Display items For Each k In d.keys Debug.Print k, d(k) Next k End Sub Returns: Item | Count 2 3 4 2 3 2 -- HTH :) Dana DeLouis Windows XP & Excel 2007 "a.riva@UCL" wrote in message ups.com... Thanks for all the suggestions! The code that Dana sent is working very well, and it's really simple :-) Now I have an other question... I have my usual option-based-1 array1 in VBA, which contains x numbers. Some of them are repeated. What I would like to do is creating an other option-based-1 array, let's call it array2, which contains the numbers of occurrences of each of the repeated elements of array1 within array1... I'm struggling to find a solution... For example: option-based-1 array1 is (1, 2, 4, 6, 5, 4, 7, 2, 3, 2, 3) -- I cannot sort the array. I think that the procedure should do the following operation: it detects how many items are repeated in "array1", and for each of this repeated items stores in a new array "array2" a number corresponding to the number of its occurrences. For example, in array1 the procedure detects that there are n=3 items which occur more than once (they are "2", "4" and "3"). Then it ReDims array2 (1 to n), and for i=1 to n it gives to array2(i) the values of: i=1 -- array2(1) = 3 (occurrences of "2"), i=2 -- array2(2) = 2 (occurrences of "4"), i=3 -- array2(3) = 2 (occurrences of "3"). Can somebody help me? Thanks in advance :-) Antonio. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Ranking function | Excel Worksheet Functions | |||
Ranking without preset Excel function. | Excel Worksheet Functions | |||
Ranking Function | Excel Worksheet Functions | |||
can excel draw with preset values | Excel Discussion (Misc queries) | |||
Is there anyway to add more than the preset 265 columns in Excel? | Excel Discussion (Misc queries) |