PDA

Vollständige Version anzeigen : Lösung mit VBA


Eschl
28.09.2016, 08:36
Hallo,
ich habe hier ein Problem und möchte es gerne per Makro lösen.
Die Zahl 1648 soll mit Hilfe der Ziffern 1 bis 7 dargestellt werden. Die Ziffern müssen in aufsteigender Reihenfolge verwendet werden und jede Ziffer kommt genau einmal vor. Die Ziffern können zu Zahlen zusammengesetzt werden, zum Beispiel: 123*(4+5+6)+7 liefert die falsche Lösung 1852. Liest man die Ziffern von rechts nach links, erhält man 7+(6+5+4)*321[liefert die falsche Lösung 4822] Gesucht ist ein Term, bei dem beide Anordnungen(1 bis 7 und 7 bis 1) das Ergebnis 1648 liefern. Erlaubt sind die Rechenoperationen +,-,*,/ und Klammern.
Kann mir jemand helfen?
Gruß, Eschl

EarlFred
28.09.2016, 08:54
.....

EarlFred
29.09.2016, 16:42
Hallo Eschl,

ich dachte immer, dass der Spaß bei Knobelaufgaben darin besteht, diese selbst zu lösen. Und wenn man das Rechnen dem Computer überlässt, sollte doch wenigstens das Erdenken des Programms Freude bereiten.
Worin liegt denn der Spaß, sich dafür ein Programm schreiben zu lassen?

Gesucht ist ein Term
ich hab 6:
=12/3*(456+7)
=123*(4+5+6)+7
=7*65*4+32*1
=7*65*4+32/1
=(7*65*4+32)*1
=(7*65*4+32)/1

Klammerungen, die keine Änderung des Vorrangs nach Punkt-Vor-Strich-Regel bewirken, sind bereits rausgefiltert.
z. B. 7*(65*4)... anstelle 7*65*4...

Grüße
EarlFred

EarlFred
29.09.2016, 17:32
Hallo Eschl,

...ach, noch der Code:

Option Explicit

Sub finder()

'L1OL2ROL3ROL4ROL5ROL6RO7R
'a.bc.def.ghi.jkl.mno.pq.r
'1.34.678.012.456.890.23.5
' 10 20 25

'L: LK; R: RK; O:OP


Dim zzz As Single: zzz = Timer
Cells(1, 1).Value = "Dauer: "

Dim strFormel As String, strTemp As String, vRet As Variant
Dim LK As Variant, OP As Variant, RK As Variant
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte
Dim f As Byte, g As Byte, h As Byte, i As Byte, j As Byte
Dim k As Byte, l As Byte, m As Byte, n As Byte, o As Byte
Dim p As Byte, q As Byte, r As Byte, z As Byte

LK = Split(" ,(", ",")
RK = Split(" ,)", ",")
OP = Split(" ,+,-,*,/", ",")

For z = 1 To 2
strTemp = IIf(z = 1, "L1OL2ROL3ROL4ROL5ROL6RO7R", "L7OL6ROL5ROL4ROL3ROL2RO1R")
For a = LBound(LK, 1) To UBound(LK, 1)
For b = LBound(OP, 1) To UBound(OP, 1)
For c = LBound(LK, 1) To UBound(LK, 1)
For d = LBound(RK, 1) To UBound(RK, 1)
For e = LBound(OP, 1) To UBound(OP, 1)
For f = LBound(LK, 1) To UBound(LK, 1)
For g = LBound(RK, 1) To UBound(RK, 1)
For h = LBound(OP, 1) To UBound(OP, 1)
For i = LBound(LK, 1) To UBound(LK, 1)
For j = LBound(RK, 1) To UBound(RK, 1)
For k = LBound(OP, 1) To UBound(OP, 1)
For l = LBound(LK, 1) To UBound(LK, 1)
For m = LBound(RK, 1) To UBound(RK, 1)
For n = LBound(OP, 1) To UBound(OP, 1)
For o = LBound(LK, 1) To UBound(LK, 1)
For p = LBound(RK, 1) To UBound(RK, 1)
For q = LBound(OP, 1) To UBound(OP, 1)
For r = LBound(RK, 1) To UBound(RK, 1)
strFormel = strTemp
Mid(strFormel, 1, 1) = LK(a)
Mid(strFormel, 3, 1) = OP(b)
Mid(strFormel, 4, 1) = LK(c)
Mid(strFormel, 6, 1) = RK(d)
Mid(strFormel, 7, 1) = OP(e)
Mid(strFormel, 8, 1) = LK(f)
Mid(strFormel, 10, 1) = RK(g)
Mid(strFormel, 11, 1) = OP(h)
Mid(strFormel, 12, 1) = LK(i)
Mid(strFormel, 14, 1) = RK(j)
Mid(strFormel, 15, 1) = OP(k)
Mid(strFormel, 16, 1) = LK(l)
Mid(strFormel, 18, 1) = RK(m)
Mid(strFormel, 19, 1) = OP(n)
Mid(strFormel, 20, 1) = LK(o)
Mid(strFormel, 22, 1) = RK(p)
Mid(strFormel, 23, 1) = OP(q)
Mid(strFormel, 25, 1) = RK(r)

strFormel = Replace(strFormel, " ", "")
vRet = Evaluate("=" & strFormel)
If IsNumeric(vRet) Then
If vRet = 1852 Then
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 2).Value = Array("'=" & strFormel, vRet)
End If
End If

Next r
Next q
Next p
Next o
Next n
Next m
Next l
Next k
Next j
Next i
Next h
Next g
Next f
Next e
Next d
Next c
Next b
Next a
Next z

Cells(1, 2).Value = Timer - zzz

End Sub

16.607.531.250 Variationen sind zu berechnen. Dauert also ein paar Augenblicke.

Grüße
EarlFred

EarlFred
30.09.2016, 15:53
...achso: 1648 soll ja rauskommen. Im Mustercode ist ein anderer Wert vorgegeben. Egal, kannst Du ja ändern.

Eschl
30.09.2016, 21:31
Hallo EarlFred,
tatsächlich, das Erdenken des Programms bereitet mir Spaß, weniger die eigentliche Lösung des Problems. Die Zahl 1648(Westfälischer Friede) ist unmissverständlich dargestellt. Deine 6 Ergebnisse sind leider alle falsch. Der Term soll sowohl von vorwärts, als auch von rückwärts gelesen die Zahl 1648(meinetwegen 1852) ergeben. 12/3*(456+7)=1852. Aber (7+654)*3/21=94,43
Ich habe lange überlegt, ob ich es wagen soll, Hilfe von den Experten zu holen. Nach einigen Tagen musste ich einsehen, dass meine Kenntnisse hier nicht ganz ausreichend sind. Ich muss dazu noch erwähnen, dass ich nicht sicher bin, ob es überhaupt eine Lösung gibt. Trotzdem, vielen Dank.
VG Eschl

EarlFred
30.09.2016, 23:08
Dass Ich nach einer anderen Zahl habe suchen lassen und die Ergebnisse daher nicht die gesuchten sind, ist sogar mir mittlerweile aufgefallen. Steht ja bereits da. Auch unmissverständlich.

Wo ist jetzt das Problem, die gesuchte Zahl im Code zu ändern und die Gegenprobe zu machen?

Hast Du Dir den Code überhaupt angesehen?

Eschl
01.10.2016, 13:41
Hallo EarlFred,
Alles habe ich nicht verstanden. Bei mir läuft der Code leider nicht. "Nicht genug Speicher...". Bei meiner Suche im Netz bin ich auf das Buch "Excel. Das Rätselbuch" von Fleckenstein...gestoßen. Dort wird ein ähnliches Problem mit VBA gelöst.("Die härtesten zwei Stunden meines Lebens") Dieser Titel besagt schon einiges. So war die Aussage des Experten, der die Lösung gefunden hat. Dein Code berechnet über "Evaluate" die Zahl 1852. Wie ich den Code verstehe, berücksichtigt das Programm beide Anordnungen, von 1 bis 7 und von 7 bis 1. Der eine String ist aber nicht "StringReverse" vom anderen, so wie die Aufgabe das verlangt. Das darf keine Beanstandung der Hilfe sein, sondern ist rein informativ.
VG Eschl