Træk 50 'tilfældige' tal - med værdi fra 1-49 - alle sammen forskellige
achrist...@gmail.com
'analog' lodtrækningsøvelse, overvejer jeg at lave et lotteri via
excel. hver deltager 'trækker' et nr. Problemet er at numrene skal
være forskellige fra gang til gang. (den samme plads må ikke
udtrækkes mere end end gang). Har overvejet at bruge Rand.between men
ved ikke hvordan jeg skal sikre mig at det samme nr. ikke bliver
udtrukket to gange.
pft.
Andreas
Erik Klausen
16g2000cwy.googlegroups.com:
Hej Andreas.
Du skriver tallene fra 1-50 i kolonne A, og formlen =SLUMP() (=RAND() på
engelsk) i kolonne B. Så markerer du blokken A1-B50 og sorterer efter
kolonne B.
Nu har du alle tallene fra 1 til 50 i tilfælding orden.
mvh. Erik Klausen
Leo Heuser
news:1166096901.4...@16g2000cwy.googlegroups.com...
pft.
Andreas
Hej Andreas
Her er én måde, du kan redde julefrokosten på :-)
1. Kopiér nedenstående kode.
2. Gå til VBA-editoren med <Alt><F11>
3. Vælg Insert > Module
4. Indsæt det kopierede i højre vindue.
5. Gå tilbage til arket med <Alt><F11>
6. Indsæt en STOR knap fra værktøjslinjen "Formularer" på arket.
7. Lad knappen kalde makroen "Julefrokost"
8. Tøm evt. kolonne A
9. Hver gang du trykker på knappen, dannes et nyt tilfældigt tal.
10. Tilføj eventuelt deltagernavne i kolonne B ud for deres tal.
Hvis du rydder tal fra kolonne A, bliver disse føjet til
din tilfældigheds-pøl (fortryde en trækning).
Du kan godt gemme projektmappen selvom alle ikke har trukket.
Næste gang, du åbner den, går du blot videre.
Sub Julefrokost()
'Leo Heuser, 14-12-2006
Dim ButtonName As String
Dim Counter As Long
Dim FirstCell As Range
Dim NewRandNumber As Double
Dim RandColl As Collection
Dim RandNumbers As Long
Dim RandRange As Range
Dim RandRangeValue As Variant
Randomize
Set FirstCell = Range("A2")
RandNumbers = 50
ButtonName = Application.Caller
Set RandRange = FirstCell.Resize(RandNumbers, 1)
RandRangeValue = RandRange.Value
Set RandColl = New Collection
For Counter = 1 To RandNumbers
RandColl.Add Item:=Counter, key:=CStr(Counter)
Next Counter
On Error Resume Next
For Counter = 1 To UBound(RandRangeValue, 1)
If Not IsEmpty(RandRangeValue(Counter, 1)) Then
RandColl.Add Item:=RandRangeValue(Counter, 1), _
key:=CStr(RandRangeValue(Counter, 1))
If Err.Number <> 0 Then
RandColl.Remove CStr(RandRangeValue(Counter, 1))
Err.Number = 0
End If
End If
Next Counter
NewRandNumber = Int(Rnd * RandColl.Count) + 1
ActiveSheet.Shapes(ButtonName).Select
With Selection.Characters
.Text = RandColl(NewRandNumber)
.Font.Size = 24
End With
With RandRange
.Cells(RandColl(NewRandNumber), 1).Value = _
RandColl(NewRandNumber)
.Cells(1, 1).Select
End With
On Error GoTo 0
End Sub
--
Med venlig hilsen
Leo Heuser
Followup to newsgroup only please.
achrist...@gmail.com
ERIK's løsning havde jeg selv googlet mig frem til, men det var LEO's
løsning som er den bedste for mig. - Tusind tak - til jer begge. Det
eneste jeg mangler er, at hver gang jeg formattere skriftstørrelsen
på knappen til str. 72 så bevare knappen kun formatteringen ved det
aktuelle tal? - Nogen hjælp?
Leo Heuser
Tak for svarene.
Velbekomme og tak for tilbagemeldingen.
Det letteste er at fjerne linjen
.Characters.Font.Size = 24
fra koden. Den sætter skriftstørrelsen til 24 punkt.
Du kan også vælge at rette linjen til:
.Characters.Font.Size = 72
Leo Heuser