View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
sali sali is offline
external usenet poster
 
Posts: 53
Default Equal list values.

"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
===================================