Создай новый проект
На форму помести TextBox
Установи MultiLine = True, ScrollBars = 2 - Vertical и растяни его на всю форму (чтобы лучше видеть)
В код Form1 помести текст:
| Код | Option Explicit
Private mR As New mRecord
Private average As Integer
Private T As TextBox
Private Sub Form_Load()
Dim localCRec As New cRec
Set T = Text1
T.Text = ""
With localCRec
.Branch_Name = "a1"
.Harmful_conditions = 23
.Quantity_of_workers = 12
mR.Add_Last localCRec
.Branch_Name = "a2"
.Harmful_conditions = 45
.Quantity_of_workers = 2
mR.Add_Last localCRec
.Branch_Name = "a3"
.Harmful_conditions = 344
.Quantity_of_workers = 45
mR.Add_Last localCRec
.Branch_Name = "a4"
.Harmful_conditions = 64
.Quantity_of_workers = 63
mR.Add_Last localCRec
.Branch_Name = "a5"
.Harmful_conditions = 222
.Quantity_of_workers = 5
mR.Add_Last localCRec
.Branch_Name = "a6"
.Harmful_conditions = 238
.Quantity_of_workers = 78
mR.Add_Last localCRec
.Branch_Name = "a7"
.Harmful_conditions = 243
.Quantity_of_workers = 47
mR.Add_Last localCRec
.Branch_Name = "a8"
.Harmful_conditions = 123
.Quantity_of_workers = 12
mR.Add_Last localCRec
.Branch_Name = "a9"
.Harmful_conditions = 923
.Quantity_of_workers = 0
mR.Add_Last localCRec
.Branch_Name = "a10"
.Harmful_conditions = 223
.Quantity_of_workers = 5
mR.Add_Last localCRec
.Branch_Name = "a11"
.Harmful_conditions = 31
.Quantity_of_workers = 22
mR.Add_Last localCRec
.Branch_Name = "a12"
.Harmful_conditions = 911
.Quantity_of_workers = 120
mR.Add_Last localCRec
End With
PrintRec "Список отраслей в предоставленной последовательности", T, mR
Calculate_average_Quantity mR, average
PrintText "Средний процент по отраслям: " & average, T
Calculate_average_QuantityProcent mR, average
Sort mR
PrintSort "Список отраслей отсортированный в порядке возрастания процента", T, mR
End Sub
|
Добавь модуль с именем «myModule» и помести туда текст
| Код | Option Explicit
Public Sub Calculate_average_Quantity(recColl As mRecord, _
average As Integer)
Dim nSumm1 As Double
Dim nSumm2 As Double
recColl.MoveFirst
Do
With recColl
nSumm1 = nSumm1 + .item.Quantity_of_workers
nSumm2 = nSumm2 + .item.Harmful_conditions
.MoveNext
End With
DoEvents
Loop While Not recColl.cCurent.NextCell Is Nothing
average = (nSumm1 * 100) / nSumm2
End Sub
Public Sub Calculate_average_QuantityProcent(recColl As mRecord, _
ByVal average As Integer)
recColl.MoveFirst
Do
recColl.item.QuantityProcent = (recColl.item.Quantity_of_workers * 100) / recColl.item.Harmful_conditions
recColl.MoveNext
DoEvents
Loop While Not recColl.cCurent.NextCell Is Nothing
End Sub
Public Sub PrintRec(ByVal sTitle As String, _
conText As TextBox, _
recColl As mRecord)
recColl.MoveFirst
conText = conText & "Title: " & sTitle & vbCrLf
conText = conText & vbCrLf
Do
With recColl
conText = conText & "Branch Name: " & .cCurent.Value.Branch_Name & vbCrLf
conText = conText & "Harmful conditions: " & .cCurent.Value.Harmful_conditions & vbCrLf
conText = conText & "Quantity of workers: " & .cCurent.Value.Quantity_of_workers & vbCrLf
conText = conText & "Quantity(%): " & .cCurent.Value.QuantityProcent & vbCrLf
End With
conText = conText & vbCrLf
recColl.MoveNext
Loop While Not recColl.cCurent.NextCell Is Nothing
End Sub
Public Sub PrintSort(ByVal sTitle As String, _
conText As TextBox, _
recColl As mRecord)
Set recColl.cCurent = recColl.cFirstSort
conText = conText & "Title: " & sTitle & vbCrLf
conText = conText & vbCrLf
Do
Set recColl.cCurent = recColl.cCurent.NextSort
DoEvents
With recColl
conText = conText & "Branch Name: " & .cCurent.Value.Branch_Name & vbCrLf
conText = conText & "Harmful conditions: " & .cCurent.Value.Harmful_conditions & vbCrLf
conText = conText & "Quantity of workers: " & .cCurent.Value.Quantity_of_workers & vbCrLf
conText = conText & "Quantity(%): " & .cCurent.Value.QuantityProcent & vbCrLf
End With
conText = conText & vbCrLf
Loop While Not recColl.cCurent.NextSort Is Nothing
End Sub
Public Sub PrintText(ByVal sTitle As String, _
conText As TextBox)
conText = conText & "Title: " & sTitle & vbCrLf
conText = conText & vbCrLf
End Sub
Public Sub Sort(recColl As mRecord)
Dim LocMin As Integer
Dim LocMax As Integer
Dim LocVal As Integer
Dim nCount As Integer
Dim new_cFirst As New Cel
Dim new_cCurents As Cel
Dim locArr() As Cel
LocMin = 100
LocMax = 0
recColl.MoveFirst
Do
LocVal = recColl.item.QuantityProcent
If LocVal > LocMax Then
LocMax = LocVal
End If
If LocVal < LocMin Then
LocMin = LocVal
End If
recColl.MoveNext
Loop While Not recColl.cCurent.NextCell Is Nothing
ReDim locArr(LocMin To LocMax)
recColl.MoveFirst
Do
With recColl
Set .cCurent.NextSort = locArr(.item.QuantityProcent)
Set locArr(.item.QuantityProcent) = .cCurent
.MoveNext
End With
Loop While Not recColl.cCurent.NextCell Is Nothing
Set new_cFirst.NextSort = locArr(LocMin)
Set new_cCurents = new_cFirst
Set recColl.cFirstSort = new_cFirst
For nCount = LocMin To LocMax
If Not locArr(nCount) Is Nothing Then
Set new_cCurents.NextSort = locArr(nCount)
Set new_cCurents = new_cCurents.NextSort
Do
If Not locArr(nCount).NextSort Is Nothing Then
Set locArr(nCount) = locArr(nCount).NextSort
Set new_cCurents.NextSort = locArr(nCount)
Set new_cCurents = new_cCurents.NextSort
End If
DoEvents
Loop While Not locArr(nCount).NextSort Is Nothing
End If
Next nCount
End Sub
|
Добавь модуль класса с именем «Cel» и помести туда текст
| Код | Option Explicit
Public Value As New cRec
Private CFm_PrevCell As Cel
Private CFm_NextCell As Cel
Private CFm_NextSort As Cel
Public Property Set PrevCell(PropVal As Cel)
Set CFm_PrevCell = PropVal
End Property
Public Property Get PrevCell() As Cel
Set PrevCell = CFm_PrevCell
End Property
Public Property Set NextCell(PropVal As Cel)
Set CFm_NextCell = PropVal
End Property
Public Property Get NextCell() As Cel
Set NextCell = CFm_NextCell
End Property
Public Property Set NextSort(PropVal As Cel)
Set CFm_NextSort = PropVal
End Property
Public Property Get NextSort() As Cel
Set NextSort = CFm_NextSort
End Property
|
Добавь модуль класса с именем «cRec» и помести туда текст
| Код | Option Explicit
Private CFm_Branch_Name As String
Private CFm_Quantity_of_workers As Integer
Private CFm_Harmful_conditions As Integer
Private CFm_QuantityProcent As Integer
Public Property Let Branch_Name(PropVal As String)
CFm_Branch_Name = PropVal
End Property
Public Property Get Branch_Name() As String
Branch_Name = CFm_Branch_Name
End Property
Public Property Let Quantity_of_workers(PropVal As Integer)
CFm_Quantity_of_workers = PropVal
End Property
Public Property Get Quantity_of_workers() As Integer
Quantity_of_workers = CFm_Quantity_of_workers
End Property
Public Property Let Harmful_conditions(PropVal As Integer)
CFm_Harmful_conditions = PropVal
End Property
Public Property Get Harmful_conditions() As Integer
Harmful_conditions = CFm_Harmful_conditions
End Property
Public Property Let QuantityProcent(PropVal As Integer)
CFm_QuantityProcent = PropVal
End Property
Public Property Get QuantityProcent() As Integer
QuantityProcent = CFm_QuantityProcent
End Property
|
Добавь модуль класса с именем «mRecord» и помести туда текст
| Код | Option Explicit
Public cFirst As New Cel ' до первой записи
Public cFirstSort As New Cel ' до первой записи Sort
Public cLast As New Cel ' после последней записи
Public cCurent As New Cel ' текущая запись
Private CFm_cCount As Integer
Public Property Get cCount() As Integer
cCount = CFm_cCount
End Property
Public Property Let cCount(PropVal As Integer)
CFm_cCount = PropVal
End Property
Public Sub Add_Last(ByVal Value As cRec) 'Добавить запис последней
Dim newCel As New Cel
With newCel
.Value.Branch_Name = Value.Branch_Name
.Value.Harmful_conditions = Value.Harmful_conditions
.Value.Quantity_of_workers = Value.Quantity_of_workers
Set .NextCell = cLast
Set .PrevCell = cLast.PrevCell
Set .PrevCell.NextCell = newCel
End With
Set cLast.PrevCell = newCel
Set cCurent = cLast.PrevCell
CFm_cCount = CFm_cCount + 1
End Sub
Private Sub Class_Initialize() 'Открытие класса
Set cFirst.NextCell = cLast
Set cLast.PrevCell = cFirst
End Sub
Private Sub Class_Terminate() 'Закрытие класса
Dim delCel As Cel
Set delCel = cFirst.NextCell
Do While Not (delCel Is cLast)
Set delCel.PrevCell = Nothing
Set delCel = delCel.NextCell
Loop
Set cCurent = Nothing
Set cFirst.NextCell = Nothing
Set cLast.PrevCell = Nothing
End Sub
Public Function item() As cRec 'Обратится к записи
Set item = cCurent.Value
End Function
Public Sub MoveFirst() 'Перейти к первой записи
Set cCurent = cFirst.NextCell
End Sub
Public Sub MoveNext() 'Перейти к следующей записи
If Not (cCurent.NextCell Is Nothing) Then
Set cCurent = cCurent.NextCell
End If
End Sub
|
ЗАПУСКАЙ(F5)!
Удачи  |
