Mit VBA Lösung suchen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Mit VBA Lösung suchen
von: alifa
Geschrieben am: 22.08.2015 17:14:28

Hi,
möchte dieses Problem(keine Hausaufgabe) mit einem Makro lösen. Leider komme ich mit ReDim nicht zurecht. Kann mir jemand helfen?
Eine Liste mit allen ganzen Zahlen von 1 bis 300. Daraus zwei,drei,vier oder fünf Zahlen auswählen, summieren und anschließend durch 13 teilen. Die ausgewählten Zahlen aus der Liste streichen und den Rest der Teilung(Summe Mod 13) hinzufügen. Das so lange tun, bis 2 Zahlen übrig bleiben. Die eine ist 89. Die andere soll ermittelt werden.
Möchte keinem das schöne Wochenende vers...
Grüße, Erhard

Bild

Betrifft: AW: Mit VBA Lösung suchen
von: Matthias
Geschrieben am: 24.08.2015 11:25:13
Hallo Erhard,
da du deinen Code vorenthältst, kann ich in punkto ReDim nur auf die Definition laut Google verweisen. Ansonsten ist der Befehl im Beispiel unten angewendet worden, sodass mein Array immer genauso groß ist wie die Anzahl der auszuwählenden Zahlen (weiterhin nur noch als k bezeichnet). Meiner Meinung nach zwar an dieser Stelle eher unnötig, da es auch ein Array(5) getan hätte und die hinteren Indexe dann einfach ungenutzt blieben. (Und für die Besserwisser: Ja ich weis dass es den Index 0 gibt, aber zum besseren Verständnis habe ich den erstmal außenvor gelassen.)
Frage 1: Die Anzahl der ausgewählten Zahlen (k = 2 bis 5) ist für die gesamte Aufgabe konstant, dh. du legst sie vorher fest, oder kann diese sich auch während des Ablaufes ändern?
Frage 2: Mit "[...] den Rest der Teilung(Summe Mod 13) hinzufügen [...]" meinst du unten an die Liste ran und dann wird dieser Rest genauso wie die ausgewählten Zahlen behandelt? Dh. er kann mitunter auch summiert und gestrichen werden?
Sowohl unter der Annahme, dass k für einen Durchgang konstant oder veränderlich seien kann, als auch dass der Rest mit summiert werden darf, hab' ich nämlich das ganze mal durchgespielt und komme leider nicht auf deine 89 und eine weitere Zahl.
Den Ausgangszustand habe ich wie folgt angelegt:
A1 und B1 -> Kopfzeile
Spalte A -> Werte von 1 bis 300
Spalte B -> Formel: =Zufallszahl()


Sub Ausgangszustand()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim x As Long
Randomize
With Tabelle1
    .Cells.Delete Shift:=xlUp
    .Range("A1").Value = "Zahlen"
    .Range("B1").Value = "Hilfsspalte"
    For x = 1 To 300
        .Range("A" & x + 1).Value = x
        .Range("B" & x + 1).Formula = "=Rand()"
    Next x
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Hier die eigentliche Aufgabe:
Sub Aufgabe()
Dim x As Long
Dim k As Byte       'Anzahl zu der Zufallszahlen (2 bis 5)
Dim arr()           'Zufallszahlen
Dim Summe As Long   'Summe der Zufallszahlen
Dim Rest As Byte    'Rest von (Summe / 13)
Application.ScreenUpdating = False
Randomize
With Tabelle1
Do
    k = 5                   ' k = konstant
    'k = Int(4 * Rnd) + 2    ' k = veränderlich
    
    'Wenn weniger Einträge verbleiben als k, dann ist k = verbleibende Einträge -2
    If (.Cells(Rows.Count, 1).End(xlUp).Row - k) < 2 Then _
    k = .Cells(Rows.Count, 1).End(xlUp).Row - 2
    
    ' Sortieren der Hilfsspalte (5 zufällige Zahlen ganz oben)
    .Columns("A:B").Sort key1:=.Range("B2"), order1:=xlAscending, Header:=xlYes
    ReDim arr(k)
    Summe = 0
    
    ' Zufallszahl summieren und entfernen
    For x = 1 To k
        arr(x) = .Range("A2").Value
        Summe = Summe + arr(x)
        .Rows(2).Delete Shift:=xlUp
    Next x
    
    ' Rest bilden und ganz unten an die Tabelle hängen
    Rest = Summe Mod 13
    x = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Range("A" & x).Value = Rest
    .Range("B" & x).Formula = "=Rand()"
    
    ' --- zur Überprüfung der Zwischenwerte ohne Schleife: ---
    ' "Do", "Loop" und "Exit Do" auskommentieren
    For x = 1 To 9
        .Range("D" & x).Value = ""
    Next x
    .Range("D1").Value = "k: " & k
    For x = 1 To k
        .Range("D" & x + 1).Value = "Zahl" & x & ": " & arr(x)
    Next x
    .Range("D7").Value = "Summe: " & Summe
    .Range("D8").Value = "Rest: " & Rest
    .Range("D9").Value = "letzte Zeile: " & .Cells(Rows.Count, 1).End(xlUp).Row
    ' --------------------------------------------------------
    
    ' Ende der Aufgabe erreicht wenn nurnoch 2 Zahlen (+ Kopfzeile = 3 Zeilen) übrig sind
    If .Cells(Rows.Count, 1).End(xlUp).Row = 3 Then
        MsgBox "Ende der Aufgabe erreicht."
        Exit Do
    End If
Loop
End With
Application.ScreenUpdating = True
End Sub
Wenn du die Schleife rausnimmst, kannst du die Zwischenwerte des Makros prüfen, die habe ich in Spalte D schreiben lassen. Den Code-Abschnitt dazu kannst du entfernen sobald alles läuft wie du es gern hättest.
lg Matthias

Bild

Betrifft: AW: Mit VBA Lösung suchen
von: Alifa
Geschrieben am: 24.08.2015 18:55:51
Hi Mathias,
vielen Dank für den Beitrag. Zu Frage 1: "schreibe die Zahlen von 1 bis 300 in eine Liste. Dann wähle zwei,drei,vier oder fünf dieser Zahlen aus, addiere sie und teile die Summe durch 13. Danach streiche die ausgewählten Zahlen und füge dafür den Divisionsrest zur Liste hinzu. Wiederhole dieses Verfahren, so oft, bis nur noch zwei Zahlen in der Liste stehen. Eine davon ist 89. Ermittle die andere." Ich denke, die Zahl 89 sollte dem Programm von Anfang an bekannt sein. Dann wird versucht, auch mittels Zahlengruppen mit verschiedener Länge(2,3,4,5), Das Endziel zu erreichen.
VG Erhard

Bild

Betrifft: Noch ein Ansatz
von: Michael
Geschrieben am: 26.08.2015 17:11:30
Hi zusammen,
ich finde die Fragestellung echt "saublöd", und auch wenn Du, Alifa, es ausdrücklich bestreitest, klingt es nach Hausaufgabe.
Aber egal, ich hab mir die Geschichte auch nochmal angesehen, und - evtl. Fehler von mir mal vorbehalten - es scheint so zu sein, als würde "immer" 3 rauskommen.
Das Makro:

Sub berechnung()
Dim a(0 To 299) As Long
Dim b(1 To 2, 1 To 5) As Long
Dim za&, zb&, amax&, bmax&, i, bsum&
' siehe Kommentar a)
a(0) = 89
For i = 1 To 88: a(i) = i: Next
For i = 89 To 299: a(i) = i + 1: Next
' siehe Kommentar b)
amax = 299
bmax = 3
Randomize Timer
While amax > 2
  bz = Int(Rnd() * bmax + 2)
  bsum = 0
  For i = 1 To bz
    b(1, i) = Int(Rnd() * (amax - 1) + 1)
'    b(2, i) = a(b(1, i))
    bsum = bsum + a(b(1, i))
    a(b(1, i)) = a(amax)
    amax = amax - 1
  Next
  bsum = bsum Mod 13
  amax = amax + 1
  a(amax) = bsum
  If amax < bmax + 2 Then
'    MsgBox "amax/bmax"
    bmax = bmax - 1
  End If
  za = za + 1
  If za Mod 500 = 0 Then MsgBox za & "  " & amax
  ' nur, falls der Algo ins Nirvana läuft
'  If za Mod 10 = 0 Then MsgBox za & "  " & amax
Wend
' MsgBox a(1)
bsum = (a(1) + a(2)) Mod 13
For i = 0 To amax: Debug.Print "i " & i & " a(i) " & a(i): Next
MsgBox "Die Zahlen lauten " & bsum & " und " & a(0)
End Sub
Es stehen noch ein paar "Debugging-Zeilen" drin, die kann man ja noch rauswerfen...
Happy Exceling,
Michael
P.S.: tjaja, ein Redim verwende ich gar nicht.
Ach ja, die Logik: wenn der Algorithmus ne Weile arbeitet, sind über kurz oder lang nur noch Zahlen vorhanden, die kleiner als 13 sind: x Mod 13 ergibt 0 bis 12.
Das bedeutet, daß die 89 auf alle Fälle NICHT gezogen und gestrichen werden darf, denn sie ist durch die MOD-Operation NICHT produzierbar.
Also habe ich sie in a(0) gesteckt und die anderen Zahlen von 1 bis 88 in a(1..88) und 90 bis 300 in a(89..299).
Es werden ja immer mindestens 2 Zahlen gestrichen und nur je eine hinzugefügt, so daß ich die ganze Operation im Array a durchführen kann; zur "Streichung" der Zahlen kopiere ich den untersten Wert (bei amax) an die zu "streichende" Stelle und vermindere amax um 1, wobei amax zur Ziehung der Zufallszahlen herangezogen wird.

Bild

Betrifft: AW: Noch ein Ansatz
von: Alifa
Geschrieben am: 26.08.2015 19:10:08
Hi,
das Makro ist meines Erachtens "saugut". Was die Hausaufgaben betrifft,Michael: Als ich Hausaufgaben machen durfte(musste), da warst Du noch nicht geboren. Also kannst Du mir das ruhig glauben.
VG Erhard

Bild

Betrifft: AW: Noch ein Ansatz
von: Michael
Geschrieben am: 27.08.2015 13:48:43
Hallo Erhard,
also, wegen des Alters wäre ich mir an Deiner Stelle nicht so sicher - ich habe auch schon ne 5 vorne dran.
Vielen Dank für das "saugut" - das höre ich natürlich gerne.
Aber: Mit dem Schleifenabbruch bin ich nicht ganz zufrieden - das Handling nach dem ersten _ Auftreten von


amax < bmax
kommt mir etwas unsauber vor.
Ich habe im Moment nur leider nicht den Kopf, dieses i-Tüpfelchen sauber zu programmieren.
Neugierig bin ich aber doch: wozu braucht man so etwas?
Hm, und im Grunde wäre es mir fast lieber, wenn es eine Hausaufgabe wäre, dann könntest Du mir nach dem Abgabetermin wenigstens sagen, ob die Lösung definitiv richtig ist.
Na gut, vielen Dank für die anregende "Nuß",
schöne Grüße,
Michael

Bild

Betrifft: AW: Noch ein Ansatz
von: Alifa
Geschrieben am: 28.08.2015 08:37:22
Hallo Michael,
Vielen Dank für die Hilfe! Ich habe auch andere Zahlengruppen in das Makro eingesetzt. Das Ergebnis war richtig. Woher ich das weiß? Das Problem lässt sich auch rein mathematisch lösen. Das habe ich herausgefunden: Wenn man natürliche Zahlen addiert und die Summe durch T teilt,bekommt man einen Divisionsrest R. Man kann die Zahlen aber auch zuerst in mehrere Gruppen aufteilen, sie dann in jeder Gruppe addieren und ihre Teilsumme durch T teilen. Addiert man alle diese Divisionsreste und teilt das Ergebnis durch T, bekommt man stets denselben Rest R, wie bei der ersten Methode. In der Liste aus der Aufgabe gibt es zu Anfang 12 Zahlen kleiner als 13. Durch jeden Schritt verschwinden zwar einige Zahlen, aber es wird immer wieder eine Zahl, die kleiner ist als 13, hinzugefügt. Dadurch gibt es immer mindestens eine Zahl kleiner als 13 auf der Liste.
VG Erhard

Bild

Betrifft: AW: Noch ein Ansatz
von: Michael
Geschrieben am: 28.08.2015 11:52:50
Hallo Erhard,
das "mathematisch lösen" hatte ich auch schon vermutet, als ich mir bei der Entwicklung mal Zwischenstände des Arrays mit kleinen amax (also überschaubare 5 oder so) ausgeben habe lassen.
Es freut mich, daß der Algo insofern verifiziert ist - schön, schön.
Ist das reiner mathematischer Spieltrieb?
Wenn Du wieder was hast, jederzeit gerne!
Schöne Grüße,
Michael

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Mit VBA Lösung suchen"