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
Post a Comment