AW: Mit VBA Lösung suchen
24.08.2015 11:25:13
Matthias
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