Prev: 2 processors
Next: Vlookup from closed excel file
From: Darren on 1 Jun 2010 11:51
Thankyou Sali. Patience is the key. I broke my list into groups of 20,
totalled thier values then run the sequence again on the new list. Then just
spilt them back up and added the original names. At least now I can show I
had minimal input in the lists generated.

"sali" wrote:

> "Darren" <Darren(a)discussions.microsoft.com> je napisao u poruci interesnoj
> grupi:CBFAF90D-0E3B-43B4-82D2-6F49D2506584(a)microsoft.com...
> > Is it possible to equally split the list into 2 columns so that the number
> > totals (B) are the same (or as near as)?
>
> here is a small sub that does the job
> just have your column [just values] selected, and call the sub 'divlist0'
> it inserts the new ws with splitted coluimns
>
> be carefull [or patient] execution time is exponential on elements number!!
> i have tested on 20 elements, 1 second on my cpu
>
> have a fun!
>
> ===============================
> 'equal split list by value/total
>
> Option Explicit
> Option Base 0
>
> 'new ws added
> Sub divlist0()
> Dim r As Range, c As Range, ulaz As Variant, i As Integer, izlaz As
> Variant
> Dim aws As Worksheet, ws As Worksheet
> Set r = Selection
> ulaz = Array()
> ReDim ulaz(r.Cells.Count)
> i = 0
> For Each c In r.Cells
> ulaz(i) = c.Value
> i = i + 1
> Next
> divlist1 ulaz, izlaz
> Set ws = Worksheets.Add
> For i = 0 To UBound(izlaz)
> ws.Cells(i + 1, izlaz(i)).Value = ulaz(i)
> Next
>
> End Sub
>
> Sub divlist1(ulaz As Variant, ByRef izlaz As Variant)
> Dim komada As Integer, komada1 As Integer, i As Integer
> Dim s1 As Double, stest As Double, dif1 As Double
> Dim bit(1000) As Boolean, bit2(1000) As Boolean
>
> komada = UBound(ulaz)
> komada1 = komada + 1
> stest = 0
> For i = 0 To komada
> stest = stest + ulaz(i)
> Next
> stest = stest / 2
> dif1 = stest
> 'bit(i)=false
> Do While Not bit(komada + 1) 'overflow->end
> For i = 0 To komada1 'increase w/overflow
> bit(i) = Not bit(i)
> If bit(i) Then
> Exit For
> End If
> Next
> s1 = 0
> For i = 0 To komada 'sum
> If bit(i) Then
> s1 = s1 + ulaz(i)
> End If
> Next
> If Abs(s1 - stest) < dif1 Then 'test best
> dif1 = Abs(s1 - stest)
> For i = 0 To komada
> bit2(i) = bit(i)
> Next
> End If
> Loop
> izlaz = Array()
> ReDim izlaz(komada)
> For i = 0 To komada
> If bit2(i) Then
> izlaz(i) = 1
> Else
> izlaz(i) = 2
> End If
> Next
>
> End Sub
> ===================================
>
>
> .
>
From: helene and gabor on 1 Jun 2010 13:45
Hello Darren,

I am working on your problem but not there yet. This site might may be dead
soon. If you find that you are interested in my algorithm then please drop
me a line.

Best Regards,

Gabor Sebo

From: sali on 1 Jun 2010 14:48

"Darren" <Darren(a)discussions.microsoft.com> je napisao u poruci interesnoj
grupi:BC303B59-C93E-446E-BAB7-E3D5DDBB487C(a)microsoft.com...

> Thankyou Sali. Patience is the key. I broke my list into groups of 20,
>
> "sali" wrote:
>
>> "Darren" <Darren(a)discussions.microsoft.com> je napisao u poruci
>> interesnoj
>> grupi:CBFAF90D-0E3B-43B4-82D2-6F49D2506584(a)microsoft.com...
>> > Is it possible to equally split the list into 2 columns so that the
>> > number
>> > totals (B) are the same (or as near as)?
>>
>> be carefull [or patient] execution time is exponential on elements
>> number!!
>> i have tested on 20 elements, 1 second on my cpu

ok, it is cpu intensive, but depending on your cpu, maybe few minutes will
be ok for whole list in single-run, better put your comp to work [and have
coffee in the meantime], than you to work manualy aranging sublists!

just to notice, i've posted two subs, the second one forceing equal length
results lists, the first one is forced to have the best possible equal
sub-totals


First  |  Prev  | 
Pages: 1 2 3
Prev: 2 processors
Next: Vlookup from closed excel file