Загрузка данных
Sub PracticalWork5()
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Name = "Фильтр"
ws.Cells.Clear
' 1. Заголовок таблицы и функция СЕГОДНЯ()
With ws.Range("A1:G1")
.Merge
.Value = "Список абитуриентов"
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.Font.Italic = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With ws.Range("H1")
.FormulaLocal = "=СЕГОДНЯ()"
.NumberFormat = "dd.mm.yy"
.Font.Name = "Arial"
.Font.Size = 14
.Font.Bold = True
.Font.Italic = True
.HorizontalAlignment = xlCenter
End With
' 2. Шапка таблицы
Dim headers As Variant
headers = Array("№", "ФИО", "Факультет", "Специальность", _
"Балл по русскому яз", "Балл по математике", _
"Балл по предмету по выбору", "Общий балл")
ws.Range("A2:H2").Value = headers
With ws.Range("A2:H2")
.Font.Name = "Arial"
.Font.Size = 12
.Font.Italic = True
.WrapText = True
.VerticalAlignment = xlBottom
End With
' 3. Заполнение данных (по образцу с рис. 3)
Dim data As Variant
data = Array( _
Array(1, "Иванов П.Р.", "Истории и МО", "История", 75, 60, 82), _
Array(2, "Петров П.С.", "Иностр. языков", "Английский", 60, 62, 75), _
Array(3, "Сергиенко А.П.", "Иностр. языков", "Японский", 74, 54, 86), _
Array(4, "Чурсина Е.А.", "Истории и МО", "Реклама", 85, 59, 69), _
Array(5, "Пеликанова Л.А.", "Истории и МО", "История", 69, 66, 74), _
Array(6, "Ремешкова О.О.", "Иностр. языков", "Японский", 73, 63, 85), _
Array(7, "Белов П.Е.", "Истории и МО", "Реклама", 82, 58, 68), _
Array(8, "Журавецкий И.Р.", "Иностр. языков", "Японский", 66, 75, 85), _
Array(9, "Прядильщикова Р.И.", "Иностр. языков", "Английский", 78, 73, 66), _
Array(10, "Кошкин Л.Е.", "Истории и МО", "Реклама", 88, 84, 79), _
Array(11, "Скакун А.З.", "Иностр. языков", "Английский", 60, 69, 73), _
Array(12, "Щорс Н.В.", "Иностр. языков", "Японский", 79, 71, 81), _
Array(13, "Цимах Г.М.", "Истории и МО", "История", 66, 55, 75) _
)
Dim i As Integer, j As Integer
For i = 0 To UBound(data)
For j = 0 To 6
ws.Cells(i + 3, j + 1).Value = data(i)(j)
Next j
' Формула суммы баллов
ws.Cells(i + 3, 8).Formula = "=SUM(E" & (i + 3) & ":G" & (i + 3) & ")"
Next i
' 4. Цвета столбцов (как на рис. 3)
ws.Range("B2:B15").Interior.Color = RGB(228, 223, 236) ' Светло-фиолетовый
ws.Range("E2:E15").Interior.Color = RGB(218, 238, 243) ' Светло-голубой
ws.Range("F2:F15").Interior.Color = RGB(253, 233, 217) ' Бежевый
ws.Range("G2:G15").Interior.Color = RGB(220, 230, 241) ' Синеватый
ws.Range("H2:H15").Interior.Color = RGB(242, 220, 219) ' Розовый
' 5. Границы и размеры столбцов
ws.Range("A1:H15").Borders.LineStyle = xlContinuous
ws.Range("A1:H2").Borders.Weight = xlMedium
ws.Columns("A").ColumnWidth = 5
ws.Columns("B").ColumnWidth = 20
ws.Columns("C:D").ColumnWidth = 16
ws.Columns("E:G").ColumnWidth = 15
ws.Columns("H").ColumnWidth = 13
ws.Rows(2).RowHeight = 45
' 6. Сортировка: сначала по Факультету (А-Я), затем по Специальности (А-Я)
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=ws.Range("C3:C15"), Order:=xlAscending
ws.Sort.SortFields.Add Key:=ws.Range("D3:D15"), Order:=xlAscending
With ws.Sort
.SetRange ws.Range("A2:H15")
.Header = xlYes
.Apply
End With
' 7. Включение автофильтра и условие > 210 (рис. 6)
ws.Range("A2:H15").AutoFilter Field:=8, Criteria1:=">210"
End Sub