Summenprüfung
27.03.2006 22:47:18
GerdL
Hallo Eljo,
die Zahlenreihe in Spalte A, ab A2 eingeben,
die Prüfsumme wird in B2,
die Trefferanzahl in C2,
die Kombinationen in Spalte D ab D2 ausgegeben.
Sub Laden()
Dim varZahlen As Variant, strEingabe As String, lngSummenzahl As Long, intRow As Integer
Columns(4).ClearContents
Cells(2, 3).ClearContents
Cells(2, 2).ClearContents
intRow = 2
Do While Cells(intRow, 1) <> ""
varZahlen = IIf(varZahlen = "", Cells(intRow, 1).Value, varZahlen & "," & Cells(intRow, 1).Value)
intRow = intRow + 1
Loop
strEingabe = InputBox("Prüfsumme")
If Not IsNumeric(strEingabe) Then Exit Sub
lngSummenzahl = CInt(strEingabe)
Cells(2, 2) = lngSummenzahl
Heuristik lngSummenzahl, varZahlen
End Sub
Function Heuristik(Betrag, Wertestring)
Dim KSumme As Long, Werte As Variant, strAusgabe As String
Dim zähler As Long, digit As Long, y As Long, x As Long
Werte = Split(Wertestring, ",", , 1)
For zähler = (2 ^ (UBound(Werte) + 1)) - 1 To 1 Step -1
digit = zähler: KSumme = 0
For y = UBound(Werte) To 0 Step -1
If Int(digit / (2 ^ y)) = 1 Then
KSumme = KSumme + CLng(Werte(y))
digit = digit - (2 ^ y)
strAusgabe = _
IIf(strAusgabe = "", Werte(y), _
Werte(y) & " " & "+" & " " & strAusgabe)
End If
Next y
If KSumme = Betrag Then
x = x + 1
Cells(x + 1, 4) = strAusgabe & " " & "= " & Betrag
End If
strAusgabe = ""
Next zähler
Cells(2, 3) = x
End Function
Gruß
Gerd