Startnummern per Zufall erzeugen
Verfasst: Fr 2. Aug 2013, 20:30
Hallo 
,
bin gerade auf LibreOffice umgestiegen und möchte mit Calc für ein Kartenturnier folgende Dinge machen:
1. den SpielerInnen, z.B. 16, automatisch eine Startnummer per Zufallsgenerator zuweisen.
Dabei darf die Startnummer nur einmal vergeben werden.
2. Dann sollen in den 4 Töpfen die Positionen (1 bis 4) der SpielerInnen per Zufallsgenerator gemischt werden - möglichst mehrfach möglich.
Mit ZUFALLSBEREICH oder ZUFALLSZAHL klappt das noch nicht richtig. Makro?
Wer weiß Rat und kann mir bitte weiterhelfen ...
LG wuppi
05.08.2013
Unter Excel habe ich die "Basis" jetzt hinbekommen. Aber beim Übertrag auf Calc funktionieren die Makros offensichtlich nicht richtig. (Unterschiede im Basic ???) Was ist zu tun, zu ändern ...
Hier mein bisheriger Stand:
A1 > Überschrift "Lfd.Nummer", B1 > Überschrift "Name" als Eingabe
A2-A17 > 1-16 als Eingabe
B2-B17 > 16 Namen als Eingabe
Makros:
1. Löschen C1 bis C17
2. Zufallsgenerator Überschrift "Startnummer" und 1 - 16
3. Sortieren nach Startnummer
4. Sortieren nach Lfd.Nummer
1.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Löschen()
'
' Löschen Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("C1:C17").Select
Selection.ClearContents
Range("E9").Select
End Sub
2.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Zufall()
'
' Zufall Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
' Löschen der "alten" Werte
Range("C1:C17").Select
Selection.ClearContents
Range("E10").Select
Dim coll As Collection, x As Byte, zfz As Byte, y As Byte
Set coll = New Collection
Wdhl:
'Zufallszahlen von 1 bis 16 generieren
For x = 1 To 16
Nochmal:
Range("C1").Formula = "=RAND()*16"
zfz = Range("C1")
If coll.Count > 1 Then
'Überprüfen, ob Zufallszahl schon vorhanden
For y = 1 To coll.Count
If coll(y) = zfz Then GoTo Nochmal
Next
End If
If zfz > 0 Then
coll.Add zfz '...hinzufügen
Else: GoTo Nochmal
End If
Next
For x = 1 To coll.Count
If coll(x) = Range("C" & x + 1) Then GoTo Wdhl
Range("C" & x + 1) = coll(x) '...ausgeben
Next
Set coll = Nothing
Range("C1") = "Startnummer"
End Sub
3.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub SortierenStartNr()
'
' SortierenStartNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E13").Select
End Sub
Sub SortierenLfdNr()
'
' SortierenLfdNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E16").Select
End Sub
4.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub SortierenStartNr()
'
' SortierenStartNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E13").Select
End Sub
Sub SortierenLfdNr()
'
' SortierenLfdNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E16").Select
End Sub
LG wuppi
,bin gerade auf LibreOffice umgestiegen und möchte mit Calc für ein Kartenturnier folgende Dinge machen:
1. den SpielerInnen, z.B. 16, automatisch eine Startnummer per Zufallsgenerator zuweisen.
Dabei darf die Startnummer nur einmal vergeben werden.
2. Dann sollen in den 4 Töpfen die Positionen (1 bis 4) der SpielerInnen per Zufallsgenerator gemischt werden - möglichst mehrfach möglich.
Mit ZUFALLSBEREICH oder ZUFALLSZAHL klappt das noch nicht richtig. Makro?
Wer weiß Rat und kann mir bitte weiterhelfen ...
LG wuppi
05.08.2013
Unter Excel habe ich die "Basis" jetzt hinbekommen. Aber beim Übertrag auf Calc funktionieren die Makros offensichtlich nicht richtig. (Unterschiede im Basic ???) Was ist zu tun, zu ändern ...
Hier mein bisheriger Stand:
A1 > Überschrift "Lfd.Nummer", B1 > Überschrift "Name" als Eingabe
A2-A17 > 1-16 als Eingabe
B2-B17 > 16 Namen als Eingabe
Makros:
1. Löschen C1 bis C17
2. Zufallsgenerator Überschrift "Startnummer" und 1 - 16
3. Sortieren nach Startnummer
4. Sortieren nach Lfd.Nummer
1.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Löschen()
'
' Löschen Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("C1:C17").Select
Selection.ClearContents
Range("E9").Select
End Sub
2.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Zufall()
'
' Zufall Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
' Löschen der "alten" Werte
Range("C1:C17").Select
Selection.ClearContents
Range("E10").Select
Dim coll As Collection, x As Byte, zfz As Byte, y As Byte
Set coll = New Collection
Wdhl:
'Zufallszahlen von 1 bis 16 generieren
For x = 1 To 16
Nochmal:
Range("C1").Formula = "=RAND()*16"
zfz = Range("C1")
If coll.Count > 1 Then
'Überprüfen, ob Zufallszahl schon vorhanden
For y = 1 To coll.Count
If coll(y) = zfz Then GoTo Nochmal
Next
End If
If zfz > 0 Then
coll.Add zfz '...hinzufügen
Else: GoTo Nochmal
End If
Next
For x = 1 To coll.Count
If coll(x) = Range("C" & x + 1) Then GoTo Wdhl
Range("C" & x + 1) = coll(x) '...ausgeben
Next
Set coll = Nothing
Range("C1") = "Startnummer"
End Sub
3.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub SortierenStartNr()
'
' SortierenStartNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E13").Select
End Sub
Sub SortierenLfdNr()
'
' SortierenLfdNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E16").Select
End Sub
4.
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub SortierenStartNr()
'
' SortierenStartNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E13").Select
End Sub
Sub SortierenLfdNr()
'
' SortierenLfdNr Makro
' Makro am 04.08.2013 von ego aufgezeichnet
'
'
Range("A1:C17").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("E16").Select
End Sub
LG wuppi