AW: Welche Kombinationen ergeben Summe
09.12.2008 19:03:45
Erich
Hallo (hier stünde dein Vorname, ( dazu schau bitte mal in die Forums-FAQ )
meinst du so etwas?
| | A | B | C | D |
| 1 | Kandidaten | Summe | Treffer | Summanden |
| 2 | 3 | 28 | 000001111 | 25 + 1 + 1 + 1 |
| 3 | 6 | | 000110000 | 12 + 16 |
| 4 | 7 | | 011100111 | 6 + 7 + 12 + 1 + 1 + 1 |
| 5 | 12 | | 100001000 | 3 + 25 |
| 6 | 16 | | 101010011 | 3 + 7 + 16 + 1 + 1 |
| 7 | 25 | | 101010101 | 3 + 7 + 16 + 1 + 1 |
| 8 | 1 | | 101010110 | 3 + 7 + 16 + 1 + 1 |
| 9 | 1 | | 110010111 | 3 + 6 + 16 + 1 + 1 + 1 |
| 10 | 1 | | 111100000 | 3 + 6 + 7 + 12 |
| 11 | | | | |
| 12 | | | | |
| 13 | | | | |
Dier Ergebnisse wurden damit ermittelt:
Option Explicit
Sub Summanden_ermitteln()
Dim kk As Integer, zz As Long, erg As String, ergT As String
Dim Atst As Double, Amax As Double
Dim anzZ As Integer, ii As Long, umsch As Boolean, arrB() As Boolean
anzZ = Cells(Rows.Count, 1).End(xlUp).Row - 1
ReDim arrB(1 To anzZ) ' Datenfeld "An/Aus" pro Zeile in Spalte A
zz = 1
Columns("C:D").ClearContents
[C1:D1] = Split("Treffer Summanden")
For ii = 1 To 2 ^ anzZ - 1 ' Schleife über Anzahl Kombinationen
Atst = 0 ' )
erg = "" ' )
umsch = True ' Schalter für An/Aus-Wechsel
For kk = anzZ To 1 Step -1 ' Schleife über Elemente des Datenfelds "An/Aus"
If umsch Then ' bis ein Element "Aus" war (Schalter auf False ist)
arrB(kk) = Not arrB(kk) ' "An/Aus" umschalten
If arrB(kk) Then umsch = False ' wenn "An"geschaltet, aufhören
End If
Atst = Atst - arrB(kk) * Cells(kk + 1, 1) ' addieren Spalte A, Zeilen mit "An"
If Atst > Cells(2, 2) Then Exit For ' verlassen, wenn Zielwert F1 überschritten
erg = IIf(arrB(kk), "1", "0") & erg ' Einsen ("An") und Nullen ("Aus") verketten
Next kk
' wenn Summe = Amax Then
If Atst > Amax Then Amax = Atst ' neue max. Summe
If Amax = Cells(2, 2) Then
zz = zz + 1
Cells(zz, 3) = erg
ergT = ""
For kk = 1 To anzZ
If arrB(kk) Then ergT = ergT & Cells(kk + 1, 1) & " + "
Next kk
Cells(zz, 4) = Left(ergT, Len(ergT) - 3)
End If
End If
Next ii
Cells(2, 2).Select
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort