For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 24
End If
Next j
Next i
End If
If Nedeli.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 168
End If
Next j
Next i
End If
If Mes.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells(i,
j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 8760
End If
Next j
Next i
End If
End If
If edin = 3 Then
If Minutes.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 1440
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 24
End If
Next j
Next i
End If
If Sutki.Value = True
Then
Exit Sub
End If
If Nedeli.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 7
End If
Next j
Next i
End If
If Mes.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 365
End If
Next j
Next i
End If
End If
If edin = 4 Then
If Minutes.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 10080
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 168
End If
Next j
Next i
End If
If Sutki.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 7
End If
Next j
Next i
End If
If Nedeli.Value = True
Then
Exit Sub
End If
If Mes.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
End If
If edin = 5 Then
If Minutes.Value = True
Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант",
vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Chas.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Sutki.Value = True
Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Nedeli.Value = True
Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Mes.Value = True Then
Exit Sub
End If
If Godi.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 12
End If
Next j
Next i
End If
End If
If edin = 6 Then
If Minutes.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 525600
End If
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not ActiveSheet.Cells(i,
j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 8760
End If
Next j
Next i
End If
If Sutki.Value = True
Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 365
End If
Next j
Next i
End If
If Nedeli.Value = True
Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Mes.Value = True Then
For i = 2 To n + 1
For j = 2 To n + 1
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 12
End If
Next j
Next i
End If
If Godi.Value = True Then
Exit Sub
End If
End If
End If
If ActiveSheet.Cells(1,
1).Value = "Начальный этап" Then
If edin = 1 Then
If Minutes.Value = True
Then
Exit Sub
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 60
Next j
Next i
End If
If Sutki.Value = True
Then
For i = 2 To scount
For j = 3 To 8
If Not
ActiveSheet.Cells(i, j).Value = "" Then
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 1440
End If
Next j
Next i
End If
If Nedeli.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 10080
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 525600
Next j
Next i
End If
End If
If edin = 2 Then
If Minutes.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 60
Next j
Next i
End If
If Chas.Value = True Then
Exit Sub
End If
If Sutki.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 24
Next j
Next i
End If
If Nedeli.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 168
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 8760
Next j
Next i
End If
End If
If edin = 3 Then
If Minutes.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 1440
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 24
Next j
Next i
End If
If Sutki.Value = True
Then
Exit Sub
End If
If Nedeli.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 7
Next j
Next i
End If
If Mes.Value = True Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 365
Next j
Next i
End If
End If
If edin = 4 Then
If Minutes.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 10080
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 168
Next j
Next i
End If
If Sutki.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 7
Next j
Next i
End If
If Nedeli.Value = True
Then
Exit Sub
End If
If Mes.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Godi.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
End If
If edin = 5 Then
If Minutes.Value = True
Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант",
vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Chas.Value = True Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Sutki.Value = True
Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Nedeli.Value = True
Then
MsgBox
"Точный перевод невозможен. Попробуйте другой вариант", vbCritical +
vbOKOnly, "Ошибка ввода"
End If
If Mes.Value = True Then
Exit Sub
End If
If Godi.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value / 12
Next j
Next i
End If
End If
If edin = 6 Then
If Minutes.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 525600
Next j
Next i
End If
If Chas.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 8760
Next j
Next i
End If
If Sutki.Value = True
Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 365
Next j
Next i
End If
If Nedeli.Value = True
Then
MsgBox "Точный перевод невозможен. Попробуйте другой вариант", vbCritical + vbOKOnly, "Ошибка ввода"
End If
If Mes.Value = True Then
For i = 2 To scount
For j = 3 To 8
ActiveSheet.Cells(i,
j).Value = ActiveSheet.Cells(i, j).Value * 12
Next j
Next i
End If
If Godi.Value = True Then
Exit Sub
End If
End If
End If
End Sub
Private Sub
UserForm_Terminate()
Hide
SolForm.StartUpPosition =
0
SolForm.Top = 350
SolForm.Left = 480
SolForm.Show
End Sub
Форма SolForm (проверка правильности заполнения
таблицы, проверка формата листа, проверка наличия данных в листе результатов,
вызов модуля формирования и заполнения таблицы результатов)
Private Sub
CommandButton1_Click()
Dim Ans As String
Dim fl As Boolean
Dim cou As Integer
cou = 0
check = True
If Not ActiveSheet.Cells(1,
1).Value = "№" Then
Ans =
MsgBox("Лист не отформатирован для расчёта, воспользуйтесь окном ввода
данных", vbCritical + vbOKCancel, "Ошибка")
If Ans = vbOK Then
Hide
InsForm.Show
Sheets("Data").Select
Exit Sub
End If
If Ans = vbCancel Then
Exit Sub
End If
End If
For i = 2 To n + 1
For j = 2 To n + 1
If Not
IsNumeric(ActiveSheet.Cells(i, j).Value) Then
MsgBox
"Длительность работы должна выражаться числом!", vbCritical +
vbOKOnly, "Ошибка"
markcell
Exit Sub
End If
kn = ActiveSheet.Cells(i,
j).Value
kk =
Fix(ActiveSheet.Cells(i, j).Value)
If kk < kn
Then
MsgBox
"Дробные числа дают погрешность при вычислении! Воспользуйтесь переводом
единиц времени, чтобы получить целые числа.", vbCritical + vbOKOnly,
"Ошибка"
markcell
Exit Sub
End If
If Not ActiveSheet.Cells(i,
j).Value = "" Then
If Not
ActiveSheet.Cells(j, i).Value = "" Then
MsgBox "Есть
этапы, которые замыкаются сами на себя! Это приведёт к зацикливанию
программы!", vbCritical + vbOKOnly, "Ошибка"
markcell
Exit Sub
End If
End If
Next j
If Not ActiveSheet.Cells(i,
i).Value = "" Then
j = i
MsgBox
"Точка отсчёта не должна имееть длительности", vbCritical + vbOKOnly,
"Ошибка"
markcell
Exit Sub
End If
Next i
For i = 2 To n + 1
fl = False
For j = 2 To n + 1
If Not
ActiveSheet.Cells(j, i).Value = "" Then
fl = True
End If
Next j
If fl = True Then
cou = cou + 1
End If
Next i
If cou = n Then
MsgBox
"Должен быть хотя бы один начальный этап!", vbCritical + vbOKOnly,
"Ошибка"
Exit Sub
End If
If cou = 0 Then
MsgBox
"Должен быть хотя бы один конечный этап!", vbCritical + vbOKOnly,
"Ошибка"
Exit Sub
End If
If hlp = True Then
Hide
HelpForm2.Show
End If
If check = False Then
Exit Sub
End If
Application.ScreenUpdating
= False
Sheets("Rez").Select
If
Sheets("Rez").Cells(1, 1).Value = "Начальный этап" Then
Ans =
MsgBox("Лист Rez уже содержит результаты вычислений. Сохранить вычисления
в другом листе?", vbCritical + vbYesNo, "Информация")
If Ans = vbYes Then
Sheets.Add
For i = 1 To 222
For j = 1 To 8
ActiveSheet.Cells(i,
j).Value = Sheets("Rez").Cells(i, j).Value
Next j
Next i
RTable
End If
End If
Sheets("Rez").Select
Range("A1:IV230").Select
Selection.Clear
RTable
Sheets("Data").Select
Solut
Application.ScreenUpdating
= True
Sheets("Rez").Select
End Sub
Private Sub
CommandButton2_Click()
Hide
InsForm.Start
InsForm.Show
Sheets("Data").Select
End Sub
Private Sub
CommandButton6_Click()
check = True
If Not
ActiveSheet.Cells(1, 1).Value = "№" Then
Страницы: 1, 2, 3, 4
|