View Single Post
  #10   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 there a code that could be written to do this type of calculation?


ha, this makes the-absolutely-best splitting
modified my previous, to force equal-length-sublist [if wanted]
nothing manual!
========================
Option Explicit
Option Base 0

Sub divlist0()
Dim r As Range, c As Range, ulaz As Variant, i As Integer, izlaz As
Variant
Dim ws As Worksheet
Set r = Selection
ulaz = Array()
ReDim ulaz(r.Cells.Count - 1)
i = 0
For Each c In r.Cells
If Not IsNumeric(c.Value) Then
MsgBox "not-a-number"
Exit Sub
End If
ulaz(i) = CDbl(c.Value)
i = i + 1
Next
If i Mod 2 < 0 Then
MsgBox "odd"
Exit Sub
End If
divlist1 ulaz, izlaz, True 'symetric divide, or any-type
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, symetric As Boolean)
Dim komada As Integer, komada1 As Integer, i As Integer, komada2 As
Integer, k As Integer, ok As Boolean
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
komada2 = komada1 / 2
stest = 0
For i = 0 To komada
stest = stest + ulaz(i)
Next
stest = stest / 2
dif1 = stest
'bit(i)=false
Do While Not bit(komada1) '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
k = 0
For i = 0 To komada 'sum
If bit(i) Then
s1 = s1 + ulaz(i)
k = k + 1
End If
Next
ok = True
If symetric And k < komada2 Then
ok = False
End If
If Abs(s1 - stest) < dif1 And ok 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
========================