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


Option Compare Database
Option Explicit

Sub Zadacha1()
    Dim dbs As Database
    Dim rstFac As Recordset      ' набор факультетов
    Dim rstStud As Recordset     ' набор студентов
    Dim rstSvod As Recordset     ' таблица Сводная
    Dim kodFac As Long
    Dim summa As Double, kolvo As Long
    Dim sredPrezh As Double, sredNov As Double
    
    Set dbs = CurrentDb
    
    ' Очищаем таблицу Сводная перед заполнением
    dbs.Execute "DELETE FROM Сводная"
    
    ' Внешний цикл — по факультетам (без явных номеров!)
    Set rstFac = dbs.OpenRecordset("Факультет", dbOpenDynaset)
    If rstFac.EOF Then Exit Sub
    rstFac.MoveFirst
    
    Do Until rstFac.EOF
        kodFac = rstFac!КодФакультета
        
        ' --- 1) Считаем ПРЕЖНЮЮ среднюю стипендию по этому факультету ---
        summa = 0
        kolvo = 0
        Set rstStud = dbs.OpenRecordset("Студенты", dbOpenDynaset)
        Do Until rstStud.EOF
            If rstStud!КодФакультета = kodFac Then
                summa = summa + Nz(rstStud!Стипендия, 0)
                kolvo = kolvo + 1
            End If
            rstStud.MoveNext
        Loop
        
        If kolvo > 0 Then
            sredPrezh = summa / kolvo
        Else
            sredPrezh = 0
        End If
        
        ' --- 2) Меняем стипендии: меньше средней → x2; нет стипендии → 2000 ---
        rstStud.MoveFirst
        Do Until rstStud.EOF
            If rstStud!КодФакультета = kodFac Then
                rstStud.Edit
                If Nz(rstStud!Стипендия, 0) = 0 Then
                    rstStud!Стипендия = 2000
                ElseIf rstStud!Стипендия < sredPrezh Then
                    rstStud!Стипендия = rstStud!Стипендия * 2
                End If
                rstStud.Update
            End If
            rstStud.MoveNext
        Loop
        
        ' --- 3) Считаем НОВУЮ среднюю стипендию по этому факультету ---
        summa = 0
        kolvo = 0
        rstStud.MoveFirst
        Do Until rstStud.EOF
            If rstStud!КодФакультета = kodFac Then
                summa = summa + Nz(rstStud!Стипендия, 0)
                kolvo = kolvo + 1
            End If
            rstStud.MoveNext
        Loop
        
        If kolvo > 0 Then
            sredNov = summa / kolvo
        Else
            sredNov = 0
        End If
        rstStud.Close
        
        ' --- 4) Записываем результат в таблицу Сводная ---
        Set rstSvod = dbs.OpenRecordset("Сводная", dbOpenDynaset)
        rstSvod.AddNew
        rstSvod!КодФакультета = kodFac
        rstSvod!НаименованиеФакультета = rstFac!НаименованиеФакультета
        rstSvod!ПрежняяСуммаСтипендии = sredPrezh
        rstSvod!НоваяСуммаСтипендии = sredNov
        rstSvod.Update
        rstSvod.Close
        
        rstFac.MoveNext
    Loop
    
    rstFac.Close
    Set dbs = Nothing
    
    MsgBox "Задача 1 выполнена. Таблица 'Сводная' заполнена."
End Sub