Загрузка данных


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