View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.programming
Darren Darren is offline
external usenet poster
 
Posts: 137
Default Equal list values.

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" je napisao u poruci interesnoj
...
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
===================================


.