Naja, du brauchst auf jedenfall zwei Schleifen. Hab mal eine Funktion von mir ein wenig umgebaut und in deinen Code eingebaut:
Option Explicit
Private Sub CommandButton7_Click()
Dim xxArray As Variant
Dim xxLenArr&()
Dim MaxXLen As Double
Dim Arr()
Dim I&, J&
Dim a$, b$, c$, str$
Dim teilstring$
a = textbox_a.Text
b = textbox_b.Text
c = textbox_c.Text
xxArray = Split(textbox_xx.Text, textbox_trennzeichen.Text)
MaxXLen = textbox_laenge.Value - (Len(a & b & c) + 3)
ReDim xxLenArr(UBound(xxArray))
For I = 0 To UBound(xxArray)
xxLenArr(I) = Len(xxArray(I))
Next
Verteilen Arr, xxLenArr, MaxXLen
For I = 0 To UBound(Arr)
For J = 0 To UBound(Arr(I))
If teilstring = "" Then
teilstring = xxArray(Arr(I)(J))
Else
teilstring = teilstring & ", " & xxArray(Arr(I)(J))
End If
Next
Debug.Print a & " " & b & " " & teilstring & " " & c
teilstring = vbNullString
Next
End Sub
Function Verteilen(Arr(), ByVal Items, Cap#) As Double
Dim a&, b&, I&, J&, S&, E&, Spot#()
Dim Sum#, TSum#, V#
Dim R&, c&, Used&
Dim NowEmpty As Boolean
'sort
'QuickSortStart Items
S = LBound(Items)
E = UBound(Items)
'allocate items
For a = E To S Step -1
NowEmpty = True
For b = a To S Step -1
If Items(b) > 0 Then
V = CDbl(Items(b))
If Sum + V <= Cap Then
Items(b) = -1
ReDim Preserve Spot(I)
Spot(I) = b
I = I + 1
Sum = Sum + V
NowEmpty = False
End If
End If
Next
If NowEmpty Then Exit For
ReDim Preserve Arr(J)
Arr(J) = Spot
J = J + 1
TSum = TSum + Sum
Sum = 0
I = 0
Next
'out
Verteilen = Cap * J - TSum
End Function
Dazu gehört noch ein Quicksort Algorithmus. Kannst dir ja was passendes im Netz suchen, ansonsten funktioniert es auch ohne Sortierung... mit Sortierung ist nur die Verteilung besser. Manchmal kann man dann Platz spaaren.
|