Автоматизация работы секретариата Федерации художественной гимнастики с помощью MS Excel

   

   Randomize

   

   For i = 1 To NomerStroki

   

   b(i) = Int(1 + (Rnd() * NomerStroki))

   d = b(i)

   c = a(i)

   a(i) = a(d)

   a(d) = c

   

   Next i

   

   For i = 1 To NomerStroki

   

   Range("d" & i + 11).Value = a(i)

   If Range("h" & i + 11).Value = "ÌÑ" Then

   Range("J" & i + 11).Value = Range("c10").Value

   Else

   If Range("h" & i + 11).Value = "ÊÌÑ" Then

   Range("J" & i + 11).Value = Range("c9").Value

   Else

   If Range("h" & i + 11).Value = "I" Then

   Range("J" & i + 11).Value = Range("c8").Value

   Else

   If Range("h" & i + 11).Value = "II" Then

   Range("J" & i + 11).Value = Range("c7").Value

   Else

   If Range("h" & i + 11).Value = "III" Then

   Range("J" & i + 11).Value = Range("c6").Value

   Else

   If Range("h" & i + 11).Value = "I þí." Then

   Range("J" & i + 11).Value = Range("c5").Value

   Else

   If Range("h" & i + 11).Value = "II þí." Then

   Range("J" & i + 11).Value = Range("c4").Value

   Else

   If Range("h" & i + 11).Value = "III þí." Then

   Range("J" & i + 11).Value = Range("c3").Value

   End If

   End If

   End If

   End If

   End If

   End If

   End If

   End If

   

   Next i

   

   'сортировка

   

   Range("D12:J" & (NomerStroki + 11)).Select

   ActiveWorkbook.Worksheets("СписокУчастниц").Sort.SortFields.Clear

   ActiveWorkbook.Worksheets("СписокУчастниц").Sort.SortFields.Add Key:=Range( _

   "J12:J" & (NomerStroki + 11)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

   xlSortNormal

   ActiveWorkbook.Worksheets("СписокУчастниц").Sort.SortFields.Add Key:=Range( _

   "D12:D" & (NomerStroki + 11)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

   xlSortNormal

   With ActiveWorkbook.Worksheets("СписокУчастниц").Sort

   .SetRange Range("D12:J" & (NomerStroki + 11))

   .Header = xlGuess

   .MatchCase = False

   .Orientation = xlTopToBottom

   .SortMethod = xlPinYin

   .Apply

   End With 

   Range("J12:J" & (NomerStroki + 11)).Select

   Selection.ClearContents

   

   Range("D12").Select

   

  End Sub 

  Sub OchistitListProtokolaSorevnovaniy() 'Очистить лист протокола соревнований 

   Sheets("ПротоколСоревнований(инд)").Select

   NomerStroki = Application.CountA(Sheets("ПротоколСоревнований(инд)").Range("a:a"))

   

   If NomerStroki <> 0 Then

   

   Range("A1:N" & NomerStroki).Select

   Selection.ClearContents

   Selection.Borders(xlDiagonalDown).LineStyle = xlNone

   Selection.Borders(xlDiagonalUp).LineStyle = xlNone

   Selection.Borders(xlEdgeLeft).LineStyle = xlNone

   Selection.Borders(xlEdgeTop).LineStyle = xlNone

   Selection.Borders(xlEdgeBottom).LineStyle = xlNone

   Selection.Borders(xlEdgeRight).LineStyle = xlNone

   Selection.Borders(xlInsideVertical).LineStyle = xlNone

   Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

   

   End If

   

   Range("A1:N1").Select

   

  End Sub 

  Sub SborProtokolaIzArhiva() 'Сбор протокола из архива 

   Dim razryad As String

   Dim god1 As Integer

   Dim god2 As Integer

   Dim mas() As String

   Dim k As Integer

   

   OchistitListProtokolaSorevnovaniy

   FormirovanieProtokolaSorevnovaniy

   

   razryad = DlyaProtokola.ComboBox1.Text

   god1 = CInt(DlyaProtokola.TextBox1.Text)

   god2 = CInt(DlyaProtokola.TextBox2.Text)

   k = 0

   

   

   Sheets("АрхивПротоколов(инд)").Select

   NomerStroki = Application.CountA(Sheets("АрхивПротоколов(инд)").Range("a:a"))

   ReDim mas(NomerStroki - 3, 10)

   

   For i = 3 To NomerStroki Step 4

   

   If Cells(i, 1) = Соревнования.TextBox3.Text Then 'дата соревнований

   

   If Cells(i + 1, 1) = Соревнования.TextBox1.Text Then ' название соревнований

   

   If Cells(i, 5) = razryad Then 'разряд

   

   If Cells(i, 6) >= god1 And Cells(i, 6) <= god2 Then ' год рождения

   

   mas(k, 0) = Cells(i, 2).Value

   mas(k, 1) = Cells(i, 3).Value

   mas(k, 2) = Cells(i, 4).Value

   mas(k, 3) = Cells(i, 5).Value

   mas(k, 4) = Cells(i, 6).Value

   mas(k, 5) = Cells(i + 3, 12).Value

   mas(k, 6) = Cells(i + 3, 18).Value

   mas(k, 7) = Cells(i + 3, 24).Value

   mas(k, 8) = Cells(i + 3, 30).Value

   mas(k, 9) = Cells(i + 3, 36).Value

   mas(k, 10) = Cells(i + 3, 42).Value

   k = k + 1

   

   End If

   

   End If

   

   End If

   

   End If

   

   Next i

   

   Sheets("ПротоколСоревнований(инд)").Select

   

   For i = 0 To k - 1

   

   Cells(i + 4, 1).Value = i + 1

   Cells(i + 4, 2).Value = mas(i, 0)

   Cells(i + 4, 3).Value = mas(i, 1)

   Cells(i + 4, 4).Value = mas(i, 2)

   Cells(i + 4, 5).Value = mas(i, 3)

   Cells(i + 4, 6).Value = mas(i, 4)

   Cells(i + 4, 7).Value = mas(i, 5)

   Cells(i + 4, 8).Value = mas(i, 6)

   Cells(i + 4, 9).Value = mas(i, 7)

   Cells(i + 4, 10).Value = mas(i, 8)

   Cells(i + 4, 11).Value = mas(i, 9)

   Cells(i + 4, 12).Value = mas(i, 10)

   Cells(i + 4, 13).Value = Cells(i + 4, 7).Value + Cells(i + 4, 8).Value + Cells(i + 4, 9).Value + Cells(i + 4, 10).Value + Cells(i + 4, 11).Value + Cells(i + 4, 12).Value

   

   Next i 

   SortirovkaIMesta

   

   'форматирование

   

   Range("B5").Select

   Selection.Copy

   Range("A4:N" & NomerStroki).Select

   Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

   SkipBlanks:=False, Transpose:=False

   Application.CutCopyMode = False

   Range("E4:N" & NomerStroki).Select

   Range("E4").Activate

   With Selection

   .HorizontalAlignment = xlCenter

   .VerticalAlignment = xlBottom

   .WrapText = False

   .Orientation = 0

   .AddIndent = False

   .IndentLevel = 0

   .ShrinkToFit = False

   .ReadingOrder = xlContext

   .MergeCells = False

   End With

   

   Range("A4:N" & NomerStroki).Select

   Selection.Borders(xlDiagonalDown).LineStyle = xlNone

   Selection.Borders(xlDiagonalUp).LineStyle = xlNone

   With Selection.Borders(xlEdgeLeft)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeTop)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeBottom)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlEdgeRight)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlInsideVertical)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   With Selection.Borders(xlInsideHorizontal)

   .LineStyle = xlContinuous

   .ColorIndex = 0

   .TintAndShade = 0

   .Weight = xlThin

   End With

   Range("B4").Select 

  End Sub