Clever-Excel-Forum

Seiten: 1 2

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

[attachment=26201]

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.

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.

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

@ Steffl
Leider macht es nicht das was ich mir vorgestellt hatte und trotzdem ein danke an dich das du dich der Sache angenommen hast.

[attachment=26207]

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  

[attachment=26208]

Aus dieser Matrix möchte ich die Zeilenposition herauslesen anhand der Größe von i.
(Diese Matrix befindet sich auf einem anderen Tabellenblatt)

[attachment=26210]

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)

[attachment=26211]

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.

[attachment=26212]

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)

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

Guten Morgen @Steffl,

die Zulosung der Freilose funktioniert prima.

Aber danach kommt folgender Fehler:
[attachment=26222]
[attachment=26223]

Hab schon probiert selber eine Lösung zu finden aber irgendwie wird das nix. :22:

Hallo,

kann ich nicht nachvollziehen. Gestern getestet, heute auch noch mal probiert, auch mit unterschiedlicher Anzahl von Freilosen. Es hat immer funktioniert.

@Steffl

Lad mal bitte die Datei wo du das getestet hast hoch dann kann ich vergleichen.

Gruß Timo

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.

Seiten: 1 2

bergaa

Käpt'n Blaubär

snb

Steffl

bergaa

Steffl

bergaa

Steffl

bergaa

Steffl