Cells(rowCount + 2, 14).Value = Str(sumWin1) + ":" + Str(sumWin2)

↑

▷ Содержание

⇐ ПредыдущаяСтр 3 из 5Следующая ⇒

3. Исходный код

Option Explicit 'об¤зательное объ¤вление переменных

Type accountTeam

Name As String ' »м¤

Score As Integer ' «абито

Missing As Integer ' ѕропущено

Winn As Integer ' ѕобед

Difer As Integer ' –азница=«абито-ѕропущено

Points As Integer 'забито+2 балла за каждую победу

End Type

Public Const n = 24 'всего команд

Public accountTeamTable() As accountTeam '—водна¤ таблица

Sub Solution()

Dim i, j, k, l, x, p, q, sumWin1, sumWin2, m, start, random1, random2, toRight, counter, rowCount As Integer

Dim s As String

ReDim accountTeamTable(1 To n) 'указываем размер массива

For i = 1 To n

   accountTeamTable(i).Name = Worksheets(2).Cells(i, 1).Value 'заполним

Next i

Worksheets(1).Activate

Worksheets(1).Cells.Clear

With Worksheets(1)   '-------------рисуем таблицы

   counter = 0

   rowCount = 2

   toRight = 0

   s = "ƒома"

   For i = 1 To 2

       For j = 1 To 2

           For k = 1 To n / 2

               .Cells(rowCount, toRight + 1).Value = s

               .Cells(rowCount + k + 1, 1 + toRight).Value = accountTeamTable(k + counter).Name

               .Cells(rowCount + 1, k + 1 + toRight).Value = accountTeamTable(k + counter).Name

           Next k

           toRight = 14

           s = " гост¤х"

           Range(Cells(rowCount + 1, 1), Cells(rowCount + 13, 13)).Borders.LineStyle = xlContinuous 'границы

           Range(Cells(rowCount + 1, 1 + toRight), Cells(rowCount + 13, 13 + toRight)).Borders.LineStyle = xlContinuous 'границы

       Next j

       counter = 12

       toRight = 0

       rowCount = rowCount + 15

       s = "ƒома"

   Next i

   counter = 0 '-----------------заполн¤ем счет

   rowCount = 2

   toRight = 0

   For l = 1 To 2

       For k = 1 To 2

          For i = 1 To n / 2

           For j = 1 To n / 2

               random1 = getRandom(10)

               random2 = getRandom(10)

               .Cells(i + rowCount + 1, j + 1 + toRight).Value = Str(random1) + ":" + Str(random2)

               If i <> j Then

                  .Cells(j + rowCount + 1, i + 1 + toRight).Value = Str(random2) + ":" + Str(random1)

               End If

               If .Cells(i + rowCount + 1, 1 + toRight).Value = .Cells(rowCount + 1, j + 1 + toRight).Value Then

                  .Cells(i + rowCount + 1, j + 1 + toRight).Clear

                  .Cells(i + rowCount + 1, j + 1 + toRight).Value = "---"

               End If

              s = .Cells(i + rowCount + 1, j + 1 + toRight).Value

              accountTeamTable(j + counter).Score = parseAccount(s, 1) + accountTeamTable(j + counter).Score

              accountTeamTable(j + counter).Missing = parseAccount(s, 2) + accountTeamTable(j + counter).Missing

              accountTeamTable(j + counter).Difer = Abs(accountTeamTable(j + counter).Score - accountTeamTable(j + counter).Missing)

              accountTeamTable(j + counter).Points = accountTeamTable(j + counter).Points + parseAccount(s, 1)

           Next j

       Next i

           toRight = 14

    Next k

       counter = 12

       toRight = 0

       rowCount = rowCount + 15

  Next l

counter = 0 '-----------------считаем победы

rowCount = 3

toRight = 0

For l = 1 To 2

   For k = 1 To 2

         For j = 1 To n / 2

            For i = 1 To n / 2

                s = .Cells(j + rowCount, i + 1 + toRight).Value

                If parseAccount(s, 1) > parseAccount(s, 2) Then

                  accountTeamTable(j + counter).Winn = accountTeamTable(j + counter).Winn + 1

                  accountTeamTable(j + counter).Points = accountTeamTable(j + counter).Points + 3 'число балов

                End If

                If parseAccount(s, 1) = parseAccount(s, 2) Then 'ничь¤

                   accountTeamTable(j + counter).Points = accountTeamTable(j + counter).Points + 1

                End If

            Next i

         Next j

         toRight = toRight + 14

    Next k

    toRight = 0

    rowCount = rowCount + 15

    counter = 12

Next l 'сортируем по количеству очков 'определ¤ем победителей

Call sortInsrt(accountTeamTable, n / 2, 0)

Call defWinner(accountTeamTable, n / 2, 0)

Call sortInsrt(accountTeamTable, n / 2, 12)

Call defWinner(accountTeamTable, n / 2, 12)

End With

Worksheets(3).Activate

With Worksheets(3)

p = 16

x = 2

toRight = 0

rowCount = 1

q = 2

For l = 1 To 3 '1/(p/2) финала

    ReDim accountTeamTable(1 To p)

    With Worksheets(2)

       For i = 1 To p

           accountTeamTable(i).Name = .Cells(i, q).Value 'заполн¤ем

       Next i

   End With

   .Cells(rowCount, 1 + toRight).Value = "1/" + Str(p / 2) + " финала"

   m = p

   For i = 1 To p / 2

           .Cells(rowCount + i + 1, 1 + toRight).Value = accountTeamTable(i).Name

           .Cells(rowCount + i + 1, 3 + toRight).Value = accountTeamTable(m).Name

           sumWin1 = 0

           sumWin2 = 0

          Call nWinn(sumWin1, sumWin2, x) 'до x побед

          If sumWin1 > sumWin2 Then

             Worksheets(2).Cells(i, 1 + q).Value = accountTeamTable(i).Name

          ElseIf sumWin1 < sumWin2 Then

             Worksheets(2).Cells(i, 1 + q).Value = accountTeamTable(m).Name

          End If

           .Cells(rowCount + i + 1, 2 + toRight).Value = Str(sumWin1) + ":" + Str(sumWin2)

            m = m - 1

   Next i

   p = p / 2 ' количество команд

   x = 3 'до скольки побед

   toRight = toRight + 4 'смещение вправо

   q = q + 1 'столбец со второго листа

Next l

.Cells(rowCount, 13).Value = "‘инал" '‘инал

For i = 1 To 2

   accountTeamTable(i).Name = Worksheets(2).Cells(i, 5).Value 'заполним

Next i

.Cells(rowCount + 2, 13).Value = accountTeamTable(1).Name

.Cells(rowCount + 2, 15).Value = accountTeamTable(2).Name

sumWin1 = 0

sumWin2 = 0

Call nWinn(sumWin1, sumWin2, 4) 'до 4х побед

MsgBox "ѕобедитель: " + .Cells(rowCount + 2, 13).Value

End With

End Sub

Public Sub nWinn(ByRef sumWin1, ByRef sumWin2, ByVal n) 'сумма первой команды, второй команды, число побед

Dim random1, random2 As Integer

Do While (True)

  random1 = getRandom(10)

  random2 = getRandom(10)

  If random1 > random2 Then

     sumWin1 = sumWin1 + 1

  ElseIf random1 < random2 Then

     sumWin2 = sumWin2 + 1

  End If

  If Abs(sumWin1 - sumWin2) = n Then

     Exit Do

  End If

Loop

End Sub

Public Sub defWinner(ByRef arr() As accountTeam, ByVal n As Integer, start As Integer)

Dim i, j As Integer

Dim rowCount As Integer

rowCount = 0

If start <> 0 Then

   rowCount = 8

End If

For i = 1 To 8

   For j = 1 To 8

       If arr(i + start).Points <> arr(j + start).Points Then

          Worksheets(2).Cells(i + rowCount, 2).Value = arr(i + start).Name

       ElseIf arr(i + start).Points = arr(j + start).Points Then

              If arr(i + start).Difer > arr(j + start).Difer Then

                 Worksheets(2).Cells(i + rowCount, 2).Value = arr(i + start).Name

              ElseIf arr(i + start).Difer = arr(j + start).Difer Then

                     If arr(i + start).Winn > arr(j + start).Winn Then

                        Worksheets(2).Cells(i + rowCount, 2).Value = arr(i + start).Name

                     End If

              End If

       End If

   Next j

Next i

End Sub

Public Sub sortInsrt(ByRef arr() As accountTeam, ByVal n As Integer, start As Integer) 'сортировка вставками start-откуда начинать сортировать

Dim i, j, k As Integer

Dim tmp As accountTeam

n = n

i = 2

Do

   j = 1

   Do

       If arr(i + start).Points >= arr(j + start).Points Then

           k = i

           tmp = arr(i + start)

           Do

               arr(k + start) = arr(k - 1 + start)

               k = k - 1

           Loop Until Not k > j

           arr(j + start) = tmp

           j = i

       Else

           j = j + 1

       End If

   Loop Until Not j < i

   i = i + 1

Loop Until Not i <= n

End Sub

Function getRandom(x As Integer)

    getRandom = Int(0 + Rnd * x)

End Function

Function parseAccount(s As String, x As Integer) As Integer ' передаем строку и число. 1- забито, 2 -пропущенно

Dim a() As String

If s = "---" Then

   parseAccount = 0

Else

  a() = Split(s, ":")

Select Case x

   Case 1 'забито

        parseAccount = a(0)

   Case 2 'пропущенно

        parseAccount = a(1)

End Select

End If

End Function

Познавательные статьи:



Техника нижней прямой подачи мяча

Комплекс физических упражнений для развития мышц плечевого пояса

Стандарт Порядок надевания противочумного костюма

Общеразвивающие упражнения без предметов