excel vba - Custom Sorting a Collection of Class by Class Property -


i have dilemma i'm not sure how approach head-on. have 3 classes

a segment class, has dictionary of customer classes, in turn have dictionaries of product classes. dictionary of customer classes needs sorted property of sumpoundssold.

i don't know start. hints?

i've figured out , answered below. ainwood posting chip pearson's code sorting collections/dictionaries!

chip pearson has this page on vba dictionaries. includes how convert collections, arrays , ranges dictionaries (or each other), , how sort dictionaries.

the (quite long!) code dictionary sorting follows:

use:

public sub sortdictionary(dict scripting.dictionary, _ sortbykey boolean, _ optional descending boolean = false, _ optional comparemode vbcomparemethod = vbtextcompare) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' sortdictionary ' sorts dictionary object. if sortbykey false, ' sort done based on items of dictionary, , ' these items must simple data types. may not ' object, arrays, or user-defined types. if sortbykey true, ' dictionary sorted key value, , items in ' dictionary may object simple variables. ' ' if sort key true, element of dictionary ' must have non-blank key value. if key vbnullstring ' procedure terminate. ' ' defualt, sorting done in ascending order. can ' sort descending order setting descending parameter ' true. ' ' default, text comparisons done case-insensitive (e.g., ' "a" = "a"). use case-sensitive comparisons (e.g., "a" <> "a") ' set comparemode vbbinarycompare. ' ' note: procedure requires ' qsortinplace function, described , available ' download @ www.cpearson.com/excel/qsort.htm . ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  dim ndx long dim keyvalue string dim itemvalue variant dim arr() variant dim keyarr() string dim vtypes() vbvartype   dim v variant dim splitarr variant  dim tempdict scripting.dictionary ''''''''''''''''''''''''''''' ' ensure dict not nothing. ''''''''''''''''''''''''''''' if dict nothing     exit sub end if '''''''''''''''''''''''''''' ' if number of elements ' in dict 0 or 1, no ' sorting required. '''''''''''''''''''''''''''' if (dict.count = 0) or (dict.count = 1)     exit sub end if  '''''''''''''''''''''''''''' ' create new tempdict. '''''''''''''''''''''''''''' set tempdict = new scripting.dictionary  if sortbykey = true '''''''''''''''''''''''''''''''''''''''' ' we're sorting key. redim arr ' number of elements in ' dict object, , load array ' key names. '''''''''''''''''''''''''''''''''''''''' redim arr(0 dict.count - 1)  ndx = 0 dict.count - 1     arr(ndx) = dict.keys(ndx) next ndx  '''''''''''''''''''''''''''''''''''''' ' sort key names. '''''''''''''''''''''''''''''''''''''' qsortinplace inputarray:=arr, lb:=-1, ub:=-1, descending:=descending, comparemode:=comparemode '''''''''''''''''''''''''''''''''''''''''''' ' load tempdict. key value come ' our sorted array of keys arr, , ' item comes original dict object. '''''''''''''''''''''''''''''''''''''''''''' ndx = 0 dict.count - 1     keyvalue = arr(ndx)     tempdict.add key:=keyvalue, item:=dict.item(keyvalue) next ndx ''''''''''''''''''''''''''''''''' ' set passed in dict object ' our tempdict object. ''''''''''''''''''''''''''''''''' set dict = tempdict '''''''''''''''''''''''''''''''' ' end of processing. '''''''''''''''''''''''''''''''' else ''''''''''''''''''''''''''''''''''''''''''''''' ' here, we're sorting items. items must ' simple data types. may not objects, ' arrays, or userdefinetypes. ' first, redim arr , vtypes number ' of elements in dict object. arr ' hold string containing '   item & vbnullchar & key ' keeps association between ' item , key. ''''''''''''''''''''''''''''''''''''''''''''''' redim arr(0 dict.count - 1) redim vtypes(0 dict.count - 1)  ndx = 0 dict.count - 1     if (isobject(dict.items(ndx)) = true) or _         (isarray(dict.items(ndx)) = true) or _         vartype(dict.items(ndx)) = vbuserdefinedtype         debug.print "***** item in dictionary object or array or udt"         exit sub     end if     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''     ' here, create string containing     '       item & vbnullchar & key     ' preserves associate between item ,     ' key. store vartype of item in vtypes     ' array. we'll use these values later convert     ' proper data type item.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''         arr(ndx) = dict.items(ndx) & vbnullchar & dict.keys(ndx)         vtypes(ndx) = vartype(dict.items(ndx))  next ndx '''''''''''''''''''''''''''''''''' ' sort array contains ' items of dictionary along ' associated keys '''''''''''''''''''''''''''''''''' qsortinplace inputarray:=arr, lb:=-1, ub:=-1, descending:=descending, comparemode:=vbtextcompare  ndx = lbound(arr) ubound(arr)     '''''''''''''''''''''''''''''''''''''     ' loop trhogh array of sorted     ' items, split based on vbnullchar     ' key element     ' of array arr.     splitarr = split(arr(ndx), vbnullchar)     ''''''''''''''''''''''''''''''''''''''''''     ' may have been possible item in     ' dictionary contains vbnullchar.     ' therefore, use ubound     ' key value,     ' last item of splitarr.     ' redim preserve splitarr     ' ubound - 1 rid of     ' key element, , use join     ' reassemble original value     ' of item.     '''''''''''''''''''''''''''''''''''''''''     keyvalue = splitarr(ubound(splitarr))     redim preserve splitarr(lbound(splitarr) ubound(splitarr) - 1)     itemvalue = join(splitarr, vbnullchar)     '''''''''''''''''''''''''''''''''''''''     ' join set itemvalue string     ' regardless of original     ' data type was. test vtypes(ndx)     ' value convert itemvalue     ' proper data type.     '''''''''''''''''''''''''''''''''''''''     select case vtypes(ndx)         case vbboolean             itemvalue = cbool(itemvalue)         case vbbyte             itemvalue = cbyte(itemvalue)         case vbcurrency             itemvalue = ccur(itemvalue)         case vbdate             itemvalue = cdate(itemvalue)         case vbdecimal             itemvalue = cdec(itemvalue)         case vbdouble             itemvalue = cdbl(itemvalue)         case vbinteger             itemvalue = cint(itemvalue)         case vblong             itemvalue = clng(itemvalue)         case vbsingle             itemvalue = csng(itemvalue)         case vbstring             itemvalue = cstr(itemvalue)         case else             itemvalue = itemvalue     end select     ''''''''''''''''''''''''''''''''''''''     ' finally, add item , key     ' our tempdict dictionary.      tempdict.add key:=keyvalue, item:=itemvalue next ndx end if   ''''''''''''''''''''''''''''''''' ' set passed in dict object ' our tempdict object. ''''''''''''''''''''''''''''''''' set dict = tempdict end sub 

note requirement qsortinplace code. won't paste here... can this link


Comments

Popular posts from this blog

ZeroMQ on Windows, with Qt Creator -

unity3d - Unity SceneManager.LoadScene quits application -

python - Error while using APScheduler: 'NoneType' object has no attribute 'now' -