OpenOffice.cz | Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)

Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)

Eduard Boldižár | 27. 09. 2017 | hodnocení: 1.00

Předchozí kapitola Zpět na obsah Následující kapitola

Vývoj V článku si predstavíme známy triediaci algoritmus, ktorým môžete v poli triediť čísla napr. od najmenších po najväčšie. Tento triediaci algoritmus je známy ako bubble sort.

Bubble sort

Bubble sort, po slovenský bublinkové triedenie, patrí medzi najmenej efektívne algoritmy na triedenie. Čiže jeho použiteľnosť v podnikových aplikáciach je silne otázne. I napriek tomu je to často prvý komplexnejší algoritmus, ktorý naučí začiatočných programátorov vnorené cykly a swapovaniu (vzájomnej výmeny). Preto si ukážeme algoritmus i my.

A najlepšie použitie triediaceho algoritmu mi pripadá v našej aplikácii LOTO, ktorá sa snaží aspoň trocha tváriť reálne a ako vidíte na stránke Tipos, skutočne sú tam vyžrebované čísla podľa poradia. Takže niečo podobné urobíme i my. Poďme najprv k princípu bubble sortu.

Majme 5 čísel:

5 10 2 48 7

A chceme ich utriediť bublinkovým triedením.

1. iterácia

5 10 2 48 7 // 5 nie je väčšie ako 10, nič sa neudeje

5 10 2 48 7 //10 je väčšie ako 2, preto dôjde k výmene

5 2 10 48 7 //10 nie je väčšie ako 48, nič sa neudeje

5 2 10 48 7 //48 je väčšie ako 7, preto dôjde k výmene

2. iterácia

5 2 10 7 48 //5 je väčšie ako 2, preto dôjde k výmene

2 5 10 7 48 //5 je menšie ako 10, nič sa neudeje

2 5 10 7 48 //10 je väčšie ako 7, preto dôjde k výmene

2 5 7 10 48 //10 je menšie ako 48, nič sa neudeje

3. iterácia doplnková iterácia, algoritmus by si mal byť istý, že je utriedené

2 5 7 10 48

2 5 7 10 48

2 5 7 10 48

2 5 7 10 48

Poďme si ukázať implementáciu bublinkového triedenia už zakomponovaného do hry LOTO. Okrem toho som optimalizoval kód hry LOTO a snáď sa vám zmeny budú páčiť.

1. program: Tipovacia hra LOTO s prídavkom bublinkového triedenia

Sub LOTO   REM začiatok procedúry 
        Dim tipPole(1 To 6) As Integer    REM deklarácie premenných 
        Dim lotoPole1(1 To 6) As Integer
        Dim lotoDodatkoveCislo1 As Integer
        Dim lotoPole2(1 To 6) As Integer
        Dim lotoDodatkoveCislo2 As Integer
        Dim vstup As String

        For i = 1 To 6  REM užívateľ zadal svoj tip
            vstup = InputBox("Zadajte váš " & i & " tip!")
            If IsNull(vstup) Then
                    MsgBox "Nič si nezadal!"
                Exit Sub        
            End If
            If Len(Trim(vstup)) = 0 Then
                MsgBox "Nič si nezadal!"
                Exit Sub        
            End If  
            If  Int(Trim(vstup)) <= 0 OR Int(Trim(vstup)) >= 50 Then   REM prvá zmena
                MsgBox "Zadal si mimo interval lotérie!"
                Exit Sub        
            End If  
            tipPole(i) = Int(vstup)
                
            For j = 1 To 6   REM  druha zmena
                If tipPole(i) = tipPole(j) Then
                        If i <> j Then
                                MsgBox "Tipy majú byť rozdielné!"
                                Exit Sub
                        End If
                End If
            Next
            vstup = ""
        Next

        Dim boolPremenna As Boolean
        Dim pocitadlo As Integer 

        For i = 1 To 6    REM tretia zmena
                 lotoPole1(i) = Int((49-1+1)*Rnd+1)
                 Do
                        pocitadlo = 0
                                For j = 1 To 6
                                        If lotoPole1(i) = lotoPole1(j) Then
                                                If i <> j Then
                                                        lotoPole1(i) = Int((49-1+1)*Rnd+1)
                                                        pocitadlo = pocitadlo + 1
                                                        Exit For
                                                End If
                                        End If
                                Next
                         Loop While pocitadlo = 1
                 Next           
        
        For i = 1 To 6 
                 lotoPole2(i) = Int((49-1+1)*Rnd+1)
                 Do
                        pocitadlo = 0
                                For j = 1 To 6
                                        If lotoPole2(i) = lotoPole2(j) Then
                                                If i <> j Then
                                                        lotoPole2(i) = Int((49-1+1)*Rnd+1)
                                                        pocitadlo = pocitadlo + 1
                                                        Exit For
                                                End If
                                        End If
                                Next
                         Loop While pocitadlo = 1
                 Next   
       
        
        boolPremenna = True
        
        Do
                pocitadlo = 0
                lotoDodatkoveCislo1 = Int((49-1+1)*Rnd+1) REM prvy ťah dodatkového čísla 
                
                For i = 1 To 6   REM testujeme či sú čísla rozdielne 
                        If lotoPole1(i) = lotoDodatkoveCislo1 Then
                                pocitadlo = pocitadlo + 1                       
                        End If          
                Next
                
                If pocitadlo = 0 Then
                        boolPremenna = False
                End If  
        Loop While boolPremenna = True 

        boolPremenna = True     
        
        Do
                pocitadlo = 0
                lotoDodatkoveCislo2 = Int((49-1+1)*Rnd+1) REM druhý ťah dodatkového čísla 
                
                For i = 1 To 6   REM testujeme či sú čísla rozdielne 
                        If lotoPole2(i) = lotoDodatkoveCislo2 Then
                                pocitadlo = pocitadlo + 1                       
                        End If          
                Next
                
                If pocitadlo = 0 Then
                        boolPremenna = False
                End If  
        Loop While boolPremenna = True 

        Dim pocitadlo1 As Integer       
        pocitadlo1 = 0
        
        For i = 1 To 6      REM konečne sme sa dostali k vyhodnocovaniu 
                For j = 1 To 6
                        If tipPole(i) = lotoPole1(j) Then
                                pocitadlo1 = pocitadlo1 + 1
                        End If
                Next
        Next
        
        Dim pocitadlo2 As Integer
        pocitadlo2 = 0
        
        For i = 1 To 6       
                For j = 1 To 6
                        If tipPole(i) = lotoPole2(j) Then
                                pocitadlo2 = pocitadlo2 + 1
                        End If
                Next
        Next
        
        
        Dim pocitadloDod1 As Integer
        pocitadloDod1 = 0

        For i = 1 To 6   
                If tipPole(i) = lotoDodatkoveCislo1 Then
                        pocitadloDod1 = pocitadloDod1 + 1                       
                End If          
        Next
        
        Dim pocitadloDod2 As Integer
        pocitadloDod2 = 0
        
        For i = 1 To 6   
                If tipPole(i) = lotoDodatkoveCislo2 Then
                        pocitadloDod2 = pocitadloDod2 + 1                       
                End If          
        Next
        
        
        Dim retazec1 As String
        retazec1 = "p"
        
        If pocitadlo1 = 6 Then 
                If pocitadloDod1 = 0 Then
                        retazec1 = "500 000 €"
                End If
        End If
        
        If pocitadlo1 = 6 Then 
                If pocitadloDod1 = 1 Then
                        retazec1 = "500 000 €"
                End If
        End If
        
        If pocitadlo1 = 5 Then
                If pocitadloDod1 = 1 Then
                        retazec1 = "10 000 €"
                End If
        End If
        
        If pocitadlo1 = 5 Then
                If pocitadloDod1 = 0 Then                
                        retazec1 = "2770,60 €"
                End If
        End If
        
        If pocitadlo1 = 4 Then
                If pocitadloDod1 = 0 Then
                        retazec1 = "29,10 €"
                End If
        End If
                
        If pocitadlo1 = 4 Then
                If pocitadloDod1 = 1 Then
                        retazec1 = "29,10 €"
                End If
        End If
        
        If pocitadlo1 = 3 Then
                If pocitadloDod1 = 1 Then 
                        retazec1 = "17,60 €"
                End If
        End If
        
        If pocitadlo1 = 2 Then
                If pocitadloDod1 = 1 Then  
                        retazec1 = "5,50 €"
                End If
        End If
        
        If pocitadlo1 = 3 Then
                If pocitadloDod1 = 0 Then
                        retazec1 = "4,40 €"
                End If
        End If
        
        If pocitadlo1 = 2 Then
                If pocitadloDod1 = 0 Then
                        retazec1 = "0 €"
                End If
        End If
        
        If pocitadlo1 = 1 Then
                If pocitadloDod1 = 1 Then
                        retazec1 = "0 €"
                End If
        End If
        
        If pocitadlo1 = 1 Then
                If pocitadloDod1 = 0 Then
                        retazec1 = "0 €"
                End If
        End If

        If pocitadlo1 = 0 Then
                If pocitadloDod1 = 1 Then
                        retazec1 = "0 €"
                End If
        End If
        
        If pocitadlo1 = 0 Then
                If pocitadloDod1 = 0 Then
                        retazec1 = "0 €"
                End If
        End If

        Dim retazec2 As String
        retazec2 = "k"
        
        If pocitadlo2 = 6 Then
                If pocitadloDod2 = 0 Then
                        retazec2 = "500 000 €"
                End If
        End If
        
        If pocitadlo2 = 6 Then
                If pocitadloDod2 = 1 Then
                        retazec2 = "500 000 €"
                End If
        End If
        
        If pocitadlo2 = 5 Then
                 If pocitadloDod2 = 1 Then
                        retazec2 = "5 000 €"
                End If
        End If
        
        If pocitadlo2 = 5 Then 
                If pocitadloDod2 = 0 Then
                        retazec2 = "250 €"
                End If
        End If
        
        If pocitadlo2 = 4 Then 
                If pocitadloDod2 = 0 Then       
                        retazec2 = "25 €"
                End If
        End If
                
        If pocitadlo2 = 4 Then 
                If pocitadloDod2 = 1 Then       
                        retazec2 = "25 €"
                End If
        End If  
        
        If pocitadlo2 = 3 Then
                If pocitadloDod2 = 1 Then 
                        retazec2 = "10 €"
                End If
        End If
        
        If pocitadlo2 = 2 Then
                If pocitadloDod2 = 1 Then  
                        retazec2 = "5 €"
                End If
        End If
        
        If pocitadlo2 = 3 Then 
                If pocitadloDod2 = 0 Then
                        retazec2 = "3 €"
                End If
        End If
        
        If pocitadlo2 = 2 Then
                If pocitadloDod2 = 0 Then
                        retazec2 = "0 €"
                End If
        End If
        
        If pocitadlo2 = 1 Then
                If pocitadloDod2 = 1 Then
                        retazec2 = "0 €"
                End If
        End If
        
        If pocitadlo2 = 1 Then
                If pocitadloDod2 = 0 Then
                        retazec2 = "0 €"
                End If
        End If

        If pocitadlo2 = 0 Then
                If pocitadloDod2 = 1 Then
                        retazec2 = "0 €"
                End If
        End If
        
        If pocitadlo2 = 0 Then
                If pocitadloDod2 = 0 Then
                        retazec2 = "0 €"
                End If
        End If
        
        Dim vytriedenePole1(1 To 6) As Integer
        Dim vytriedenePole2(1 To 6) As Integer
        Dim pomocnaPremenna As Integer 
        
        For i = 1 To 6
                vytriedenePole1(i) = lotoPole1(i)
        Next 
         
        For i = 1 To 6
                vytriedenePole2(i) = lotoPole2(i)
        Next
        
        For i = 1 To 5    REM štvrtá zmena je bubble sort
                For j = 1 To 5 
                        If vytriedenePole1(j) > vytriedenePole1(j+1) Then
                                pomocnaPremenna = 0
                                pomocnaPremenna = vytriedenePole1(j+1)
                                vytriedenePole1(j+1) = vytriedenePole1(j)
                                vytriedenePole1(j) = pomocnaPremenna
                        End If
                Next
        Next        
        
        For i = 1 To 5  REM bubble sort
                For j = 1 To 5 
                        If vytriedenePole2(j) > vytriedenePole2(j+1) Then
                                pomocnaPremenna = 0
                                pomocnaPremenna = vytriedenePole2(j+1)
                                vytriedenePole2(j+1) = vytriedenePole2(j)
                                vytriedenePole2(j) = pomocnaPremenna
                        End If
                Next
        Next 
        REM a nakoniec vyvrcholenie programu
        
        MsgBox "Deň žrebovania: 27.08.2017" & Chr(10) & "Váš tip: " & tipPole(1) & " " & tipPole(2) & " " & tipPole(3) & " " & tipPole(4) & " " & tipPole(5) & " " & tipPole(6) & " " & Chr(10) & "1. ťah: " & lotoPole1(1) & " " & lotoPole1(2) & " " & lotoPole1(3) & " " & lotoPole1(4) & " " & lotoPole1(5) & " " & lotoPole1(6) & Chr(10) & "Podľa poradia: " & vytriedenePole1(1) & " " & vytriedenePole1(2) & " " & vytriedenePole1(3) & " " & vytriedenePole1(4) & " " & vytriedenePole1(5) & " " & vytriedenePole1(6) & " " & Chr(10) & "A dodatkové číslo k 1. ťahu: " & lotoDodatkoveCislo1 & Chr(10) & "2. ťah: " & lotoPole2(1) & " " & lotoPole2(2) & " " & lotoPole2(3) & " " & lotoPole2(4) & " " & lotoPole2(5) & " " & lotoPole2(6) & Chr(10) & "Podľa poradia: " & vytriedenePole2(1) & " " & vytriedenePole2(2) & " " & vytriedenePole2(3) & " " & vytriedenePole2(4) & " " & vytriedenePole2(5) & " " & vytriedenePole2(6) & Chr(10) & "A dodatkové číslo k 2. ťahu: " & lotoDodatkoveCislo2 & Chr(10) & Chr(10) & "V 1. ťahu ste uhadli " & pocitadlo1 & " čísla a " & pocitadloDod1 & " dodatkových čísel a vyhrávate " & retazec1 & "!" & Chr(10) & "V 2. ťahu ste uhadli " & pocitadlo2 & " čísla a " & pocitadloDod2 &  " dodatkových čísel a vyhrávate " & retazec2 & "!"

End Sub   REM koniec procedúry

Výsledok aj s vyžrebovanými číslami podľa poradia

Rozbor makra:

Zmeny v programe oproti minulej implementácie hry LOTO sú niekoľko. Rozpíšeme si ich v bodoch.

1. zmena: optimalizácia vstupu s pomocou pridania logického súčtu OR

2. zmena: ak zadá užívateľ vstup mimo definovaný interval, tak skončí makro hneď a nie až po skončení zadávania intervalu šiestich čísel

3. zmena: vylepšený algoritmus produkcie náhodných čísel pre hru LOTO. Algoritmus už nemusí generovať 6 nových čísel pri objavení chyby, ale vygeneruje len jedno číslo práve tam, kde nastala chyba (rozumejte, že sa vyskytlo rovnaké číslo aké už bolo vyžrebované).

4. zmena: pridané bublinkové triedenie

Okrem bublinkového triedenia existuje nespočetne veľa triediacich algoritmov. Môžeme sa im venovať, ale až v záverečnej etape seriálu. Zatiaľ máme za sebou začiatky a ešte nás čaká jedno alebo dve články k začiatočnej fázy seriálu a potom naskočíme k náročnejším veciam.

Předchozí kapitola Zpět na obsah Následující kapitola

Komentáře

neutr

Odpovědět
Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)
27. 09. 2017, 19:05:53

Tenhle příspěvek se mi už moc nelíbí přestože je z pohledu pochopení postupů správně. 350 řádků je moc. Mimo toho sice řeší chybu při zápisu duplicity, ale řeší to tak že proces ukončí.

Vlastní volba čísel (tip) musí být zabezpečena z uživatelského hlediska lépe. Věřím, že tyto nedostatky autor zná a chtěl s nimi něco udělat - možná postupně v rámci seriálu. Ve skutečnosti by na to mělo stačit maximálně 100 řádků kódu. Uvádím ukázku která řeší dvěma různými způsoby zadávání tipů. je to jednak zřízení návratových cyklů při chybě tak aby se dalo opravit volbu a pokračovat. Dále zápis dříve vybraných do záhlaví. Tam si zadávající může prohlednout co tam už má a chybě se vyhnout - a pak by systém podle článku postačoval.

I v následujícím kódu je dost zbytečných řádků a není tam generátor náhorných čísel - ale i na dva tahy je to jen o něco více nežli na vlastní BubleSort

Sub Main
Dim tipPole(1 To 6)
Dim SortPole(1 To 6)
Dim sVar, sVal, sInfo as string
Dim vstup, rep, A, B, swap As integer
For i = 1 To 6
HopStart:
vstup = Val(InputBox("Zadajte váš " & i & " tip!", "Dosud vybráno : " & sInfo))
Select Case vstup
Case < 1 'Test pro storno, respektive 0, nebo záporná čísla
rep = MsgBox(" Chyba nebylo zadáno žádné číslo. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
Case > 49 'Test na čísla větší nežli 49
rep = MsgBox(" Chyba bylo zadáno číslo mimo hrací pole. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
Case Else 'Test na duplicitní zadání
IF i > 1 Then
For j = i-1 To 1 Step - 1
IF vstup = tipPole(j) Then
rep = MsgBox(" Chyba bylo zadáno již dříve vybrané číslo. Postup opakujte," & _
" nebo zadávání ukončete." + Chr(13) + Chr (13) & _
"ANO - nová volba" + Chr(13) & _
"NE - ukončit volbu.",4,"CHYBA ZADÁNÍ")
IF rep = 7 Then
Exit Sub
Else
GoTo HopStart 'skok pro opakování volby
End If
End If
next j
End If
tipPole(i) = vstup 'Vlastní uložení tipovaného čísla
sInfo = sInfo & vstup & " + "
End Select
Next i

For i = 1 To 6
SortPole(i) = tipPole(i) 'děláme pracovní kopii pole pro třídění
sVar = svar & tipPole(i) & ", " 'text hlášení ZVOLENÁ ČÍSLA
next i
'------------------------Buble sort - plný cyklus bez kontroly konce
For i = 6 To 2 Step - 1
For j = 1 To i-1
A = SortPole(j)
B = SortPole(j+1)
IF A > B Then
swap = B
B = A
A = swap
SortPole(j) = A
SortPole(j+1) = B
End If
next j
Next i

For i = 1 To 6 'text hlášení PŘETŘÍDĚNÁ ČÍSLA
sVal = sVal & SortPole(i) & ", "
Next i

MsgBox("Váš tip 6 čísel bez přetřídění" + Chr(13) & _
" " & svar + Chr(13) + Chr(13) & _
"Váš tip 6 čísel po přetřídění" + Chr(13) & _
" " & sval ,64, "ZVOLENÁ ČÍSLA")
End Sub

lp.

Odpovědět
Programovanie makier v LibreOffice: Bubble sort (bublinkové triedenie)
28. 09. 2017, 01:06:30

Musím se připojit k neutr. Ukázka s použitím procedur. I tak je řádků dost.

Sub LOTO2 REM začiatok procedúry
Dim tipPole(1 To 6) As Integer REM deklarácie premenných
Dim lotoPole1(1 To 7) As Integer ' Posledni cislo je dodatkova
Dim lotoDodatkoveCislo1 As Integer
Dim lotoPole2(1 To 7) As Integer ' Posledni cislo je dodatkova
Dim lotoDodatkoveCislo2 As Integer
Dim vstup
Dim bVsazeno As Boolean

For i = 1 To 6 REM užívateľ zadal svoj tip
Do
bVsazeno = False
vstup = InputBox("Zadajte váš " & i & " tip!")
If IsNull(vstup) or (Len(Trim(vstup)) = 0) Then
MsgBox "Nič si nezadal!"
Exit Sub ' OK nějak ukončíme
End If

tipPole(i) = Int(vstup)

If tipPole(i) < 1 OR tipPole(i) > 50 Then
MsgBox "Zadal si mimo interval lotérie!"
elseif not PosledniJeUnikatni(tipPole, 1, i) Then
MsgBox "Tipy majú byť rozdielné!"
else
bVsazeno = true
end if
vstup = ""
Loop Until bVsazeno
Next

Tah(lotoPole1, 1, 50) ' Prvni tah
Tah(lotoPole2, 1, 50) ' Druhy tah

' Rozebereme tazena cisla
lotoDodatkoveCislo1 = lotoPole1(7)
lotoDodatkoveCislo2 = lotoPole2(7)

' Odebereme z tahu dodatkové číslo
ReDim Preserve lotoPole1(1 to 6)
ReDim Preserve lotoPole2(1 to 6)

' Setřídíme cisla
BubbleSort(tipPole)
BubbleSort(lotoPole1)
BubbleSort(lotoPole2)

' Vyhodnocení
' 1. tah
Dim Vyhry(0 to 6)
Dim VyhryDod(0 to 6)
Dim retazec1 as string
Dim retazec2 as string

' Vyhry v prvnim tahu
VyhryDod = Array(500000, 10000, 29.10, 17.60, 5.5, 0, 0 )
Vyhry = Array(500000, 2770.60, 29.10, 4.4, 0, 0, 0 )

retazec1 = VyhoceniTahu(1, tipPole, lotoPole1, lotoDodatkoveCislo1, VyhryDod, Vyhry)

' 2. tah
' Vyhry ve druhem tahu
VyhryDod = Array(500000, 5000, 25, 10, 5, 0, 0 )
Vyhry = Array(500000, 250, 25, 3, 0, 0, 0 )

retazec2 = VyhoceniTahu(2, tipPole, lotoPole2, lotoDodatkoveCislo2, VyhryDod, Vyhry)

REM a nakoniec vyvrcholenie programu

MsgBox "Deň žrebovania: 27.08.2017" & Chr(10) & _
"Váš tip: " & Join(tipPole, " ") & " " & Chr(10) & _
"1. ťah: " & Join(lotoPole1, " ") & Chr(10) & _
"A dodatkové číslo k 1. ťahu: " & lotoDodatkoveCislo1 & Chr(10) & _
"2. ťah: " & Join(lotoPole2, " ") & Chr(10) & _
"A dodatkové číslo k 2. ťahu: " & lotoDodatkoveCislo2 & Chr(10) & Chr(10) & _
retazec1 & Chr(10) & _
retazec2

End Sub REM koniec procedúry

' Procedura naplní Cisla unikátními čísly od Prvni do Posledni
Sub Tah(ByRef Cisla, prvni as integer, posledni as integer)
' Prvni nemusime testovat
Cisla(1) = VybratCislo(prvni,posledni)
For i = lbound(Cisla,1) + 1 To ubound(Cisla,1)
Do
Cisla(i) = VybratCislo(prvni,posledni)
Loop Until PosledniJeUnikatni(Cisla, 1, i)
Next
end sub

function VybratCislo(prvni as integer, posledni as integer) as integer
VybratCislo = Int((posledni-1+prvni)*Rnd+1)
end function

' Funkce testuje jestli je posledni cislo unikatni
' Nevim, který prvek je posledni, dám to jako parametr
function PosledniJeUnikatni(Cisla, prvni, posledni) as boolean
PosledniJeUnikatni = false

For j = prvni To posledni-1
If Cisla(j) = Cisla(posledni) Then exit function
next
PosledniJeUnikatni = true
end function

Sub BubbleSort(ByRef Cisla)
Dim pom as Integer
Dim t as integer
Dim N as integer

N = UBound(Cisla, 1)

Do
t = 0
For j = LBound(Cisla, 1) To N - 1
If Cisla(j) > Cisla(j+1) then
pom = Cisla(j)
Do
Cisla(j) = Cisla(j+1)
j = j + 1
If j = N Then Exit Do
Loop While pom > Cisla(j + 1)
Cisla(j) = pom
t = j
End If
Next
N = t - 1
Loop Until t = 0
End Sub

' Funkce porovná dvě číselná pole a zjistí počet shod
' Predpokládá, že polej sou setříděná
Function PocetShod(Tip As Variant, Tah As Variant) As Integer
Dim i As Integer, j As Integer
PocetShod = 0

j = 1
For i = 1 To 6 REM konečne sme sa dostali k vyhodnocovaniu
Do While Tip(i) >= Tah(j)
If Tip(i) = Tah(j) Then
PocetShod = PocetShod + 1
end if
j = j + 1
if j > 6 then exit for
Loop
Next
End Function

' Opět, 2x stejné operace, dáme do procedury
Function VyhoceniTahu(CisloTahu, tipPole, lotoPole1, DodatkoveCislo, VyhryDod, Vyhry) As String
Dim Shody as Integer
Dim Dodatek as Integer

Shody = PocetShod(tipPole, lotoPole1)

Dodatek = 0
For i = 1 To 6
If tipPole(i) = lotoDodatkoveCislo1 Then
Dodatek = 1
Exit For
End If
Next
VyhoceniTahu = "V " & CisloTahu & ". ťahu ste uhadli " & Shody & " čísla a " & Dodatek & " dodatkových čísel a vyhrávate "

If Dodatek = 1 Then
VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!"
Else
VyhoceniTahu = VyhoceniTahu & Format(VyhryDod(6 - Shody), "#,##0.00 ""€""") & "!"
End If

End Function