'
' Процедура главная :: начало
'
Sub berger2023()
'
' Расчет Коэффициента Бергера для определения мест и премий
' Автор: wpvi.ru
' Находится здесь: https://wpvi.ru/fs/soft/excel/berger2023_ver102.txt
' Используется здесь: https://wpvi.ru/pages/soft/excel/
' Версия 1.02 от 20230106
'
  Quest1 = "Добрый день, " & Application.UserName & " !" & Chr(13) & "Вы действительно хотите запустить расчет Коэффициента Бергера для определения мест и премий?"
  Ans1 = MsgBox(Quest1, vbYesNo)
  If Ans1 = vbYes Then
    ' Запуск расчета
    rez1 = make_berger()
  Else
    ' Отказ от запуска расчета
    rez1 = decline_berger()
  End If
  Exit Sub
End Sub

'
' Процедура главная :: завершение
'

Public Function decline_berger() As Boolean
  MsgBox "Вы отказались от расчета!"
  task_done = False
  Exit Function
End Function

Public Function make_berger() As Boolean
  MsgBox "Вы согласились провести расчет!"
  rez_count_berger = count_berger()
  task_done = True
  MsgBox "Докладываю: процесс завершен. Результат: " & rez_count_berger
  Exit Function
End Function

Public Function count_berger() As Boolean
  Dim x, y, myN As Integer
  Dim game_rez, cur_op_total_points, kb, place_cur As Single ' Currency
  Dim money_cur As Double
  Dim points_and_kb_ar(10) As Double
  Dim points_and_kb_ar_sorted As Variant
  Dim myN_ceil, game_rez_ceil, cur_op_total_points_ceil, kb_ceil As String
  ' Dim opN_ar(10) As String ' Массив соответствия номеров противников по строкам с буквами по столбцам.
  opN_ar = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
  ' MsgBox "Проверка opN_ar с индексом 1: " & opN_ar(1)
  ' MsgBox "Проверка opN_ar с индексом 0: " & opN_ar(0)

  ' myN - номер текущего участника - не путать с x - номер строки, это немного, но другое!
  ' game_rez - результат партии 0 - 0,5 - 1
  ' cur_op_total_points - очки текущего оппонента
  ' kb - здесь храним рассчитываемое значение коффициент Бергера для текущего участника
  For x = 1 To 10
  ' Проход по каждому участнику, их всего 10
    myN_ceil = "A" + CStr(x + 2)
    myN = Sheets("Турнирная таблица").Range(myN_ceil).Value
    ' MsgBox "Ячейка с номером текущего участника: " & myN_ceil
    ' MsgBox "Номер текущего участника: " & myN
    kb = 0 ' обнуляем коффициент Бергера для текущего участника
    For y = 1 To 10
    ' Проход по всем противникам
      game_rez_ceil = opN_ar(y - 1) + CStr(myN + 2)
      game_rez = Sheets("Турнирная таблица").Range(game_rez_ceil).Value
      cur_op_total_points_ceil = "N" + CStr(y + 2)
      cur_op_total_points = Sheets("Турнирная таблица").Range(cur_op_total_points_ceil).Value
      If game_rez > 0 Then
        kb = kb + (game_rez * cur_op_total_points)
        Else
      End If
      ' MsgBox "Ячейка результатом: " & game_rez_ceil & " :: Результат: " & game_rez & " :: Ячейка результата противника: " & cur_op_total_points_ceil & " :: Результат противника: " & cur_op_total_points
    Next y
    ' MsgBox "kb: " & kb
    kb_ceil = "O" + CStr(x + 2)
    Sheets("Турнирная таблица").Range(kb_ceil) = kb
  Next x
  ActiveWorkbook.Save
  ' Считаем points_and_kb_ar(10)
  For x = 1 To 10
    points_and_kb_ar(x - 1) = (Sheets("Турнирная таблица").Range("N" + CStr(x + 2)).Value) * 1000 + (Sheets("Турнирная таблица").Range("O" + CStr(x + 2)).Value)
    ' MsgBox "x: " & x & " :: points_and_kb_ar: " & points_and_kb_ar(x - 1)
  Next x
  ' Определяем места
  For x = 1 To 10
    ' MsgBox "x: " & x & " :: points_and_kb_ar_sorted: " & points_and_kb_ar_sorted(x)
    points_cur = points_and_kb_ar(x - 1)
    place_ceil = "P" + CStr(x + 2)
    place_cur = 1
    ' Теперь считаем кол-во игроков, у которых результат лучше текущего points_cur
    For y = 1 To 10
      ' MsgBox "points_cur: " & points_cur & " :: points_and_kb_ar: " & points_and_kb_ar(y - 1) & " :: place_cur: " & place_cur
      If points_cur < points_and_kb_ar(y - 1) Then
        place_cur = place_cur + 1
      End If
    Next y
    ' фиксируем место
    Sheets("Турнирная таблица").Range(place_ceil) = place_cur
  Next x
  ' Определяем премии
  For x = 1 To 10
    place_ceil = "P" + CStr(x + 2)
    money_ceil = "Q" + CStr(x + 2)
    place_cur = Sheets("Турнирная таблица").Range(place_ceil).Value
    money_cur = Sheets("Распределение фонда премий").Range("B" + CStr(place_cur + 2)).Value
    Sheets("Турнирная таблица").Range(money_ceil) = money_cur
  Next x
  '
  ' ***** Конец *****
  count_berger = True
  Exit Function
End Function