valmis excel-lotto

ikituuri kirjoitti:

tää arpoo ja läjittelee numerot pienimmästä suurimpaan ja tarkistaa ettei sama numero tuu kahdesti!

Option Explicit

' Makro arpoo käyttäjän haluaman määrän lottorivejä.
'

' Alustetaan muuttujat
Dim Varsinainen(7) As Integer ' Taulukko varsinaisia lottorivejä varten

Dim Arpa, i, l, o, v, x, y As Integer ' Muuttujia erinäisiin tarkoituksiin

' ------------------------
' Tästä alkaa pääohjelma
' ------------------------
'
' Pääohjelma arpoo numerot function Satunnaisluku avulla
' ja tarkistaa ettei tule samoja numeroita. Lopuksi tulostaa
' käyttäjän haluaman määrän sarakkeita (lottorivejä).

Sub ARVO_LOTTORIVI()

' Alustetaan muuttujat
Dim Maksimi As Integer
Dim Onko, Test As Integer

Range("C12").Select

Poista ' Kutsutaan aliohjelmaa Poista

For i = 1 To ActiveCell.Value

Range("C10").Select ' Näillä saadaan
ActiveCell.Offset(1, i).Formula = Chr(64 i) ' sarakkeiden päälle kirjaimet.

For v = 1 To 7 ' Varsinaisten lottonumeroiden
Do ' arvonta ja tarkistetaan, ettei
Onko = 1 ' tule kahta samaa numeroa
Varsinainen(v) = Satunnaisluku(39, 0.5)
For Test = 1 To v - 1
If Varsinainen(v) = Varsinainen(Test) Then
Onko = 0
End If
Next
Loop While Onko = 0
Next



Lajittele ' Kutsutaan aliohjelmaa Lajittele

For y = 1 To 7 ' Tulostetaan lomakkeelle varsinaiset lottonumerot
Range("C11").Select
ActiveCell.Offset(y, i).Formula = Varsinainen(y)
Next


Next
Range("A10").Select
Range("C12").Select
End Sub

' Funtion Satunnaisluku arpoo sekä lottonumerot
Function Satunnaisluku(Alue, Pyoristys)
Satunnaisluku = Rnd * Alue Pyoristys
End Function

' Aliohjelma Lajittele järjestää taulukoidut lottonumerot
' suuruusjärjestykseen alkaen pienimmästä
Sub Lajittele()
Dim hylly As Integer
For o = 1 To 6 ' Lajitellaan lottonumerot
For v = o 1 To 7 ' kättelyalgoritmilla
If Varsinainen(o) > Varsinainen(v) Then
hylly = Varsinainen(o)
Varsinainen(o) = Varsinainen(v)
Varsinainen(v) = hylly
End If
Next
Next


End Sub

' Aliohjelma Poista tyhjentää edelliset arvotut lottorivit
Sub Poista()
Range("D10:IV23").Select
Selection.ClearContents
Range("C12").Select
End Sub

kirjoitti:

Anonyymi

Kirjoita kommentti

5000

Lähetä