Registriert seit: 27.08.2019
Version(en): Professional 2010
Moin zusammen,
folgendes Problem hat sich bei mir ergeben:
Ich habe eine Anzahl an Spieler und eine Anzahl an Freilosen.
Je nach dem wie viel Freilose ich habe durch eine Variable i, möchte ich in meine Tabelle "Auslosung" nach einer Matrix Zellen beschreiben. (Mit dem Wort "Freilos")(Die Matrix befindet sich nicht im gleichen Tabellenblatt)
Danach möchte ich die Anzahl an Spielern die ich davor ermittelt habe und in ein Array eingelesen, per Zufall durchgemischt in die gleiche Tabelle eintragen.
Dabei darf keine Zelle beschrieben oder befüllt werden in dem schon das Wort Freilos steht.
Es kann sich natürlich die Anzahl an Spielern und Freilosen je nach Anwendung des Plan's ändern. So muss ich alles variabel gestalten.
In der Beispieldatei habe ich einige Info's hinterlassen.
Im Tabellenblatt "16er SKO" Info 1
Im Tabellenblatt "Freilose" Info 2
und nochmal ein Hinweis bzw. Beispiel auf dem Tabellenblatt "16er SKO".
Auch im meinem Codegestrüpp habe ich einige Kommentare hinterlassen die evtl als Hinweis dienen oder helfen sollte.
Insgesamt sind in der Excel-Mappe 3 Tabellenblätter enthalten, dass Blatt das sich am Anfang öffnet ist vorausgefüllt.
Das wichtigste für euch, ja es gibt viele verbundene Zellen und sollte ich meine Mappe weiter entwickeln werde ich in Zukunft darauf verzichten. Hierbei aber durch einen komplexen Aufbau und der Darstellung nicht mehr umzusetzen. Oder ehrlich gesagt ist mir das jetzt zu viel Arbeit.
Vielen Dank schon mal an jeden der mir da weiter helfen kann
Beispieldatei.xlsm (Größe: 94,67 KB / Downloads: 2)
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
Hallo,
Zitat:Das wichtigste für euch, ja es gibt viele verbundene Zellen und sollte ich meine Mappe weiter entwickeln werde ich in Zukunft darauf verzichten.
... aus eigener, leidvoller Vergangenheit stammt die Erkenntnis:
nichts ist so beständig, wie ein Provisorium.
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!
Grüße aus Norderstedt, Peter
Registriert seit: 29.09.2015
Version(en): 2030,5
Wo un wann wird die Lösung dieses Rätsels publiziert ?
Wenn die Aufhebung verbundene Zellen zuviel Arbeit ist, ist die Lösung deines Rätsel das für mich auch.
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
Code: Private Sub CommandButton1_Click()
Dim Antwort As VbMsgBoxResult
Dim Meldung As String
Dim i, z As Integer
Dim zaehler As Long
Dim varArray1 As Variant, varTemp As Variant
Dim intIndex As Integer, intRND As Integer
Meldung = "M?chten Sie wirklich Losen ?" & vbCrLf & vbCrLf & "Achten Sie darauf, dass Lose und Spieler" & vbCrLf & "zum Spielplan passen!"
Antwort = MsgBox(Meldung, vbYesNo + vbQuestion, "16er SKO Losung")
If Antwort = vbYes Then
Range("K30:T45").ClearContents 'Inhalt der Zieltabelle l?schen
Else: Exit Sub
End If
i = Range("AU31").Value 'Anzahl der Freilose
zaehler = Range("AC30:AC45").Cells.Count - WorksheetFunction.CountBlank(Range("AC30:AC45"))
z = zaehler + i
'Wieso machst Du einen String daraus?
If z = 16 Then
'If z = "16" Then
varArray1 = Range(Cells(30, 29), Cells(zaehler + 29, 29)).FormulaLocal 'Zelle AC30 bis AC(x) einlesen
Randomize Timer 'Zufallsgenerator initialisieren
Else
MsgBox "Falsche Freilos Eingabe"
GoTo Ende
End If
For intIndex = UBound(varArray1) To 1 Step -1 'Array zuf?llig mischen
intRND = Fix((intIndex * Rnd) + 1)
varTemp = varArray1(intRND, 1)
varArray1(intRND, 1) = varArray1(intIndex, 1)
varArray1(intIndex, 1) = varTemp
Next
If i = 0 Then
Range(Cells(30, 11), Cells(45, 11)).FormulaLocal = varArray1 'Ausgabe des Array ohne Freilos
'Ab hier komme ich mit der Ausgabe ins straucheln
'Falls das Feld Freilos leer bleibt oder 0 eingetragen wird trifft mein erster Fall ein
'und falls i gr??er wie 8 sein sollte habe ich bereits auch eine L?sung, aber f?r i = 1-8 habe ich keinen Ansatz
'Vielen Dank schonmal f?r Ihre M?he und f?r Ihre Zeit
ElseIf i > 8 Then MsgBox "Zu wenig Zu losende Spieler" & vbCrLf & "N?chst kleineren Plan verwenden"
Else
Range(Cells(30, 11), Cells(29 + UBound(varArray1), 11)).FormulaLocal = varArray1
End If
Ende:
End Sub
Gruß Stefan
Win 10 / Office 2016
Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:1 Nutzer sagt Danke an Steffl für diesen Beitrag 28
• bergaa
Registriert seit: 27.08.2019
Version(en): Professional 2010
@ Steffl
Leider macht es nicht das was ich mir vorgestellt hatte und trotzdem ein danke an dich das du dich der Sache angenommen hast.
Da trage ich die Anzahl ein die ich verteilen möchte und diese Zahl wird in die Variable i gespeichert.
Code: i = Range("AU31").Value
Aus dieser Matrix möchte ich die Zeilenposition herauslesen anhand der Größe von i.
(Diese Matrix befindet sich auf einem anderen Tabellenblatt)
So sollte es aussehen wenn man an diesem Punkt der Verteilung der Freilose den Programmablauf anhalten könnte.
(Hier wie in der Beispieldatei i = 3, d.h. laut Matrix in Zeile 1, 16, 8 das Wort Freilos eintragen)
(3 Plätze von insgesamt 16 sind belegt, ergo fehlen noch 13 Spieler)
Diese 13 Spieler sind bereits in einem Array gespeichert und zufällig durchgemischt worden.
Code: i = Range("AU31").Value 'Anzahl der Freilose
zaehler = Range("AC30:AC45").Cells.Count - WorksheetFunction.CountBlank(Range("AC30:AC45"))
z = zaehler + i
If z = 16 Then
varArray1 = Range(Cells(30, 29), Cells(zaehler + 29, 29)).FormulaLocal 'Zelle AC30 bis AC(x) einlesen
Randomize Timer 'Zufallsgenerator initialisieren
Else
MsgBox "Falsche Freilos Eingabe"
GoTo Ende
End If
For intIndex = UBound(varArray1) To 1 Step -1 'Array zufällig mischen
intRND = Fix((intIndex * Rnd) + 1)
varTemp = varArray1(intRND, 1)
varArray1(intRND, 1) = varArray1(intIndex, 1)
varArray1(intIndex, 1) = varTemp
Next
Die Zuteilung der Freilose sollte nach dem Mischen des Arrays erfolgen und dann möchte ich in den leeren Zeilen das Array ausgeben.
Ganz wichtig wäre, ich darf auf keinen Fall die Freilose die schon eingetragen wurden überschreiben.
So sollte dann das fertige Ergebnis aussehen.
(wichtig ist übrigens auch das in der Tabelle Auslosung keine Formel stehen darf, weil dieser Bereich wird mit einem anderen Button komplett gelöscht)
Danke nochmal, an alle die mir helfen möchten. :28:
Ich hoffe so kommt ihr vielleicht einfacher auf eine Lösung. Ich wäre euch so dankbar.
(Beispieldatei im Startbeitrag)
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
wenn nicht unbedingt im Bereich K30:K45 Formel stehen müssen geht es so.
Code: Private Sub CommandButton1_Click()
Dim Antwort As VbMsgBoxResult
Dim Meldung As String
Dim i, z As Integer
Dim zaehler As Long
Dim varArray1 As Variant, varTemp As Variant
Dim intIndex As Integer, intRND As Integer
Dim lngA As Long
Dim rngZelle As Range
Meldung = "M?chten Sie wirklich Losen ?" & vbCrLf & vbCrLf & "Achten Sie darauf, dass Lose und Spieler" & vbCrLf & "zum Spielplan passen!"
Antwort = MsgBox(Meldung, vbYesNo + vbQuestion, "16er SKO Losung")
If Antwort = vbYes Then
Range("K30:T45").ClearContents 'Inhalt der Zieltabelle l?schen
Else: Exit Sub
End If
i = Range("AU31").Value 'Anzahl der Freilose
zaehler = Range("AC30:AC45").Cells.Count - WorksheetFunction.CountBlank(Range("AC30:AC45"))
z = zaehler + i
'Wieso machst Du einen String daraus?
If z = 16 Then
'If z = "16" Then
varArray1 = Range(Cells(30, 29), Cells(zaehler + 29, 29)).Value2 'Zelle AC30 bis AC(x) einlesen
Randomize Timer 'Zufallsgenerator initialisieren
Else
MsgBox "Falsche Freilos Eingabe"
GoTo Ende
End If
For intIndex = UBound(varArray1) To 1 Step -1 'Array zuf?llig mischen
intRND = Fix((intIndex * Rnd) + 1)
varTemp = varArray1(intRND, 1)
varArray1(intRND, 1) = varArray1(intIndex, 1)
varArray1(intIndex, 1) = varTemp
Next
lngA = 1
Do
Range("K30:K45").Cells(Worksheets("Freilose").Range("N8:Q9").Cells(lngA).Value).Value = "Freilos"
lngA = lngA + 1
Loop While lngA <= i
If i = 0 Then
Range(Cells(30, 11), Cells(45, 11)).FormulaLocal = varArray1 'Ausgabe des Array ohne Freilos
'Ab hier komme ich mit der Ausgabe ins straucheln
'Falls das Feld Freilos leer bleibt oder 0 eingetragen wird trifft mein erster Fall ein
'und falls i gr??er wie 8 sein sollte habe ich bereits auch eine L?sung, aber f?r i = 1-8 habe ich keinen Ansatz
'Vielen Dank schonmal f?r Ihre M?he und f?r Ihre Zeit
ElseIf i > 8 Then MsgBox "Zu wenig Zu losende Spieler" & vbCrLf & "N?chst kleineren Plan verwenden"
Else
lngA = 1
For Each rngZelle In Range("K30:K45")
If rngZelle.Value = "" Then rngZelle.Value = varArray1(lngA, 1): lngA = lngA + 1
Next rngZelle
' Range(Cells(30, 11), Cells(29 + UBound(varArray1), 11)).FormulaLocal = varArray1
End If
Ende:
End Sub
Gruß Stefan
Win 10 / Office 2016
Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:1 Nutzer sagt Danke an Steffl für diesen Beitrag 28
• bergaa
Registriert seit: 27.08.2019
Version(en): Professional 2010
Guten Morgen @Steffl,
die Zulosung der Freilose funktioniert prima.
Aber danach kommt folgender Fehler:
Hab schon probiert selber eine Lösung zu finden aber irgendwie wird das nix. :22:
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
kann ich nicht nachvollziehen. Gestern getestet, heute auch noch mal probiert, auch mit unterschiedlicher Anzahl von Freilosen. Es hat immer funktioniert.
Gruß Stefan
Win 10 / Office 2016
Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:1 Nutzer sagt Danke an Steffl für diesen Beitrag 28
• bergaa
Registriert seit: 27.08.2019
Version(en): Professional 2010
@Steffl
Lad mal bitte die Datei wo du das getestet hast hoch dann kann ich vergleichen.
Gruß Timo
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo Timo,
ich habe das in deiner hochgeladenen Datei getestet. Vermutlich hast Du nur einen Teil vom Code eingefügt und dabei nicht bemerkt, dass ich oben beim Einlesen auch was geändert habe.
Gruß Stefan
Win 10 / Office 2016
Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:1 Nutzer sagt Danke an Steffl für diesen Beitrag 28
• bergaa
|