|
|
SynopsisThe function attempts to divide a given number of discrete items into equal groups and minimize the number of groups needed. This is useful for scenarios where you may want to avoid layouts where you have 4 items on first page and only 1 items on second page. Running 5 items for maximum of 4 through the function will return { 3, 2 }, enabling you to know that you'd put 3 items on one page and 2 on next page. Here's some examples of output the function will return for different parameters. For a maximum of 5 items per group: Items #: 1 2 3 4 5 6 7 8 9 10 11 12 Group 1: 1 2 3 4 5 3 4 4 5 5 4 4 Group 2: 0 0 0 0 0 3 3 4 4 5 4 4 Group 3: 0 0 0 0 0 0 0 0 0 0 3 4 For a maximum of 4 items per group: Items #: 1 2 3 4 5 6 7 8 9 10 11 12 Group 1: 1 2 3 4 3 3 4 4 3 4 4 4 Group 2: 0 0 0 0 2 3 3 4 3 3 4 4 Group 3: 0 0 0 0 0 0 0 0 3 3 3 4 Likewise, 3 maximum per group: Items #: 1 2 3 4 5 6 7 8 9 10 11 12 Group 1: 1 2 3 2 3 3 3 3 3 3 3 3 Group 2: 0 0 0 2 2 3 2 3 3 3 3 3 Group 3: 0 0 0 0 0 0 2 2 3 2 3 3 Group 4: 0 0 0 0 0 0 0 0 0 2 2 3 The function expects two input and will infer the minimum number of groups required to distribute the discrete items equally as possible and returns the result as an array in the same order as you would have seen in the example shown above. You can infer the number of groups needed by doing a Ubound() + 1 on the returned array. CODE ' EqualGrouping
' http://www.utteraccess.com/wiki/index.php/EqualGrouping ' Code courtesy of UtterAccess Wiki ' Licensed under Creative Commons License ' http://creativecommons.org/licenses/by-sa/3.0/ ' ' You are free to use this code in any application, ' provided this notice is left unchanged. ' ' rev date brief descripton ' 1.0 2011-10-20 ' Public Function EqualGrouping( _ MaxPerGroup As Long, _ ItemCount As Long _ ) As Long() Dim lngGroupsNeeded As Long Dim lngItems As Long Dim lngResult As Long Dim lngResults() As Long Dim i As Long 'Iterator If ItemCount < MaxPerGroup Then ReDim lngResults(0) lngResults(0) = ItemCount Else If ItemCount Mod MaxPerGroup Then lngGroupsNeeded = (ItemCount \ MaxPerGroup) + 1 Else lngGroupsNeeded = ItemCount / MaxPerGroup End If lngItems = ItemCount ReDim lngResults(lngGroupsNeeded - 1) For i = lngGroupsNeeded To 1 Step -1 lngResult = lngItems \ i lngItems = lngItems - lngResult lngResults(i - 1) = lngResult Next End If EqualGrouping = lngResults End Function
|
| This page was last modified 12:05, 21 October 2011. This page has been accessed 592 times. Disclaimers |