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