|
Dim S_INV As Long
'Минимальное значение инвестирования (в вариаmах)
Dim N_Fact_INV,
ii_Fact_INV, i_Fact_INV As Long 'Фактическое число вариантов инвестирования
Dim i_INV, nn_Fact_INV, ii_INV As Long 'значение текущею номера вариаmа инвестирования Dim j_in_i1NV As Long 'З,начение текущего номера варианта инвестирования в
рамках i
Dim V _i_INV As Double
'Значение текущего варианта инвестирования
Dim V j_in_iINV As Double
'значение текущего варианта инвестирования
Dim N_Mestor As Integer
'Число месторождений (текущее рабочее опред:ление)
Dim Flg As Integer 'флаг
для определиния было ли изменене максимума
Dim Мах_Мах As Double
'абсолютный максимум
DataBook = ""
ProgramВook = ''''
ResultBook = ""
'Начало работы, процедура
открытия файла с исходными данными
'1)
Сall OpenDataFile
'Определяем отказ от
работы
If DataBook =
"" Then
Exit Sub
End If
Выдаем информацию в
строке состояния
Application,StatusBar =
"Создаются массивы с данными"
Вводим исходные данные
Саll GetData
Определяем максимальный
объем инвестирования
Sredstva = О
Tst_MIN = 999999999999#
Мах_Мах = О 'сейчас для
поиска максимального варианта инвестирования
Fоr i_DAO = 1 То N_DAO
Fоr i_Mestor = 1 То DАО(i_DАо).коlМеstог
Выбор максимального
варианта инвестирования среди текущих вариamов
Tst_MAX=O
Рот i_ Vart = 1 То DAO(i_DAO),Mestor(i_Mestor).KoIVart
IfTst_MAX <
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) Then
Tst_MAX =
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) End If
'Выбор максимального
варианта инвестирования среди всех
IfMax_Max <
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) Then
Мах_Мах = DAO(i_DAO).Mestor(i_Mestor).Inv(i_
Vart) End If
'Выбор нач. знач для инвестирования
IfTst_MIN >
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) Then
Tst_MIN = DАО(i_DАО).Меstш(i_Меstог).Iпv(i_ Vart)
End If
Next i_ Vart
Sredstva =
Sredstva + Tst_MAX Next i_Mestor
Nexti_DAO
'Начальное значение
инвестирования V _i_INV = Tst_MIN
Tst_ MIN =
99999999999999#
'Выбор вариаmа DEL ТА для
полного оптимума
Fог i_DAO = 1 То N_DAO
Fог i_Mestor = 1 То DAO(i_DAO).KoIMestor
Fот i_ Vart = 1 То DАО(i_DАО).Меstог(i_Меstог).коIVагt Рот ii_DAO = i_DAO То N_DAO
Fот ii_Mestor = 1 То DAO(ii_DAO).KoIMestor
Рот ii_ Vart = 1 То DАО(ii_DАО).Меstог(ii_Меstог).коIVагt
'Выбор варианта приращения инвестирования
If
Abs(DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) -
DAO(ii_DAO).Mestor(ii_Mestor).Inv(ii_ Vart» <> О Then
IfTst_MIN>Abs(DAO(i_DAO).Mestor(i_Mestor).Inv(i_Vart)DAO(ii_DAO.Mestor(ii_Mestor).Inv(ii_
Vart» Then
Tst_MIN =
Abs(DAO(i_DAO).Mestor(i_Mestor).Inv(i_Vart)-DAO(ii_DAO).Mestor(ii_Mestor).Inv(ii_
Vart»
End If
End If
Next ii_ Vart
Next ii_Mestor
Nextii DAO
Next i_ Vart
Next i_Mestor
Nexti_DAO
**************************************************
Заполнение для
'всевозможных вариантов инвестирования
Вычисление общего числа
месторождений
N _ Mestor = О 'нач знач
общего числа местор.
For i_DAO = 1 То N_DAO
N_Mestor =
N_Mestor + DAO(i_DAO).KoIMestor
Next i_DAO
Delta =
Tst_MIN
Flg=O
M_INV = Iпt(Мах_Мах /
Delta) + 1 'Число приращений для максимального варианта
Tst_ МАХ = О 'нач знач
про верки на максимум
Выдаем иформацию в строкеl
состояния
Application.StatusBar =
"Идет процесс оптимизации"
Определение начальных и
конечных индексов в вариантах инвестирования
N_Fact_INV = О 'Начальное
число вариантов инвестирования
N_INV =
Int(Sredstva / Delta) + 1
S_INV =
Int(Tst_MIN / Delta)
IfS_INV = О Then
S_INV = 1
End If
М _ INV = Int(Max _Мах /
Delta) + 1 'Число приращений для максимального варианта
For i_INV =
S_INV То M_1NV
Текущий объем
инвестирования
V _i_INV = Delta * i_INV
For i_DAO = 1 То N_DAO
For i_Mestor =
1 То DАО(i_DАо).коlМеstог
For i_ Vart =
1 То DАО(i_DАО).Меstоr(i_Меstог).коlVагt
Проверка хватает ли
текущего объема инвестирования для добычи
IfV _i_INV
>= DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) Then
Проверка включения данных
по месторождению
fflag = О
For i = 1 То N]act_INV
IfDAO(i_DAO).Mestor(i_Mestor).Name
= FMAX1(i).FNameMestor_
And
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) = _
FMAX1(i).FInv Then
месторождение уже
записано
fflag = 1
Exit For
End If
Next i
If fflag = О Then
'записываем в порядке увеличения объемов инвестирования
N_Fact_INV = N_Fact_INV +
1 'Число вариантов инвестиций в для одного месторож
ReDim Preserve
FMAX1(N]act_INV)
FMAX1(N]act_INV).FMAX
= DAO(i_DAO).Mestor(i_Mestor).Dob(i_ Vart)
FMAXl
(N_Fact_INV).F _i_INV = i_INV
FMAX1(N]act_INV).FDob
= DAO(i_DAO).Mestor(i_Mestor).Dob(i_ Vart) FMAXl(N]act_INV).Flnv =
DAO(i_DAO).Mestor(i_Mestor).Inv(i_ Vart) FMAXl(N]act_INV).FNameDAO =
DAO(i_DAO).NameDAO
FMAXl (N ]act_
INV).FNameMestor = DAO(i_ DAO).Mestor(i_ Mestor).Name End If
End lf
Next i_Vart
Next i_Mestor
Nexti_DAO
Next i_INV
********************************************************
Flg=O
ReDim
FMAX2(N_INV - S_INV)
Поиск оптимального
решения
Tst_MAX = О 'нач знач про
верки на максимум
ReDim FMAX4(!)
ReDim FMAX4(!
).FNameMestor(N _ Mestor)
Мах_Мах=О nn]act_INV = О
Проход по вариантам
финансирования одновременно i_Mestor месторождений
For i_INV =
S_INV То N_INV
значение текущего номера
варианта инвестирования в рамках общего инвестир i_INV
For j_injINV =
S_INV То i_INV
Находим FМAX
соответствущий текущеI.jY инвестированию j_in_iINV
Ifj_in_iINV <> UNV
Then 'Условие обязательно, если (lIВНЫ, то FMAX2(O)!!!
For i_Fact_INV
= 1 То N_Fact_INV
Ifj_in_iINV =
FMAX1(i]act_INV).F_i_INV Тhеп
Tst_MAX =
FMAX1(i]act_INV).FMAX + FMAX2(i_INV - j_in_iINV)
ExitFor
End If
Next i]act_INV
Else 'если равны,то
For i]act_INV
= 1 То N]act_INV
Ifj_in_iINV =
FMAXl (i]act_INV).F _i_INV Тhen
Tst_MAX =
FMAX1(i]act_INV).FMAX
Exit For
End If
Next i Fact
INV
End If
IfTst_MAX> Мах_Мах + 0.00001 Тhen
Flg = 1 'предполагаем,
что месторождение еще не используется в финансировании
Проверка на участие
месторождения в двух финансированиях одновременно
Ifj_injINV
<> i_INV Тhеп
For
i_tstMestor = 1 То nn_Fact_INV
Находим предыдущий индекс
объема дающий текущий максимум
IfFMAX4(i_tstMestor).F
_i_INV = i_INV - FMAXl(i]act_INV).F _i_INV Тhеп
'Проверяем на совпадение
имен среди имен предыдущего индекса
For i_ Vart =
1 То UBoиnd(FMAX4(i_tstМestor).FNameMestor)
IfFMAX4(i_tstMestor).FNameMestor(i_
Vart) = FMAX1(i]act_INV).FNameMestor Тhеп
Попытка улучшить общий
результат заменой "старого" варианта
инвестирования в
месторождение с этим именем, новым вариантом
If Tst_MAX -
FMAX4(i_ Vart).FDob <= Мах_Мах + 0.0001 Тhеп
Flg = О 'месторождение
уже используется в финансировании
Tst_MAX = Мах_Мах
fflagl = О
ExitFor
Else 'Попытка замены
варианта инвест. в месторождение на этом объеме общих инвестиций Tst_MAX =
TsCMAX - FMAX4(i_ Vart).FDob
fflag = i_
Vart
fflagl = 2
Exit For
End If
End If Next i_
Vart End If
lfFJg = О Ог fflagI = 2 Тhen
Exit For
End If
Next i_tstМestor
End If
End If
запись нового результата
для данного объема финансирования
IfFlg = 1 Тhen
Flg=O
nn_Fact_INV =
nn_Fact_INV + 1
Записываем используемые
ранее имена при получении макс на этом объеме
ReDim Preserve
FMAX4(nn]act_INV)
ReDim Preseгve FMAX4(nn _Fact_INV).FNameMestor(nn
_Fact_ INV) FMAX4(nn]act_INV).FMAX = Tst_MAX
FMAX4(nn]act_INV).FDob
= FMAXl(i_Fact_INV).FDob
FMAX4(nn ]act_
INV).Flnv = FMAXl (i]act_ INV).Flnv
FMAX4(nn]act_INV).NmМestor = FMAXl (i]act_INV).FNameMestor
FMAX4(nn_Fact_INV).F
_i_INV = i_INV 'Обшие объемы
вложения
FMAX4(nn_Fact_INV).FNameDAO = FMAX1(i_Fact_INV).FNameDAO
FMAX4(nn ]act_
INV).FNameMestor(nn ]act_ INV) = FMAXl (i_Fact_ INV).FNameMestor
Ifj_in_iINV
<> i_INV Тhen
For ii_INV = 1
То nn]act_INV
IfFMAX4(ii_INV).F
_i_INV = i_INV - FMAXl(i]act_INV).F _i_INV Тhen
For i_ Vart =
1 То
UBound(FMAX4(ii_INV).FNameMestor) FMAX4(nn]act_INV).FNameMestor(i_ Vart) =
FMAX4(ii_INV).FNameMestor(i_ Vart)
If fflagl = 2
Then 'Исключаем двойное
инвестирование в месторождение, давшее
максимум
IfFMAX4(ii_INV).FNameMestor(i_ Vart) = FMAXl(i]act_INV).FNameMestor Тhеп FMAX4(nn_Fact_INV).FNameMestor(fflag) = ""
fflagl = О
End If
End If
Next i Vart
End If
Nextii_INV
FMAX4(nn
]act_INV).FNameMestor(nn]act_ INV) = FMAX] (i]act_ INV).FNameMestor
End If
Мах_Мах = Tst_MAX
FMAX2(i_INV) =
Мах_Мах
Flg=O
End If
Next j_in
_iINV
Nexti_INV
Обработка результатов
Dim OиtRezO As Мах2
Выдача результатов
SubResи1t_oиt(FMAX]О, FMAX40)
End Sиb
Sиb Resиlt_oиt(FМAXIO As Мах], FMAX40 As Мах2)
Dim Sheet As Worksheet 'Переменная для текущих листов
Dim ListNameO
As String
Dim
arrayindex, nSheets, Add_n_Sheet, OиtSheet As Integer
Для каждой новой
номенклатуры создается свой лист результатов
Начальные значения
arrayindex = ]
'Определяет номер имени в массиве имен
nSheets = О
Add_n_Sheet = О
OutSheet = 3 'Необходимое число листов
ReDim ListName(OutSheet)
ListName(l) =
"Оптимизация добычи нефти"
ListName(2) = "Для
заметок 1"
ListNamе(З) = "Для
заметок 2"
ListName(4) =
"Максимизация"
Формирование имени книги
результатов
ResиltBook = Time
&" "& Date &" "&" Результаты
оптимизации "
Выдаем иформацшо в строке
состояния
Application.StatusBar =
"Создаю книry результатов: "& ResultВook
Создаем новую книry
Запрещаем переход на
новое окно
Application.ScreenUpdating
= False
Workbooks.Add
Вписываем данные в
свойства файла
With
ActiveWorkbook
Title = ResиltBook
Sиbject = "Оптимизация добычи
нефти"
End With
Замена двоеточий и точек
в дате на подчеркивания
ResиltВook = Replace(ResиltВook, ":", "_")
ResиltBook = Rep]ace(Resи1tBook, ".", "_")
Сохранение файла для
изменения имени в текущем каталоге
ActiveWorkbook.SaveAs
(ResиltBook)
Число листов в открытой
книге
nSheets = 3
Добавляем листы
Add_n_Sheet =
OиtSheet - nSheets
If Add_n_Sheet
> О Тhеп
Worksheets.Add
Coиnt:=Add_n_Sheet
End If
Переименовываем листы
For Eacl1
Sheet In ActiveWorkbook. Worksheets
If IПStr(l, Sheet.Name, "Лист") Тhеп
Sheet.Name =
ListName(arrayindex) arrayindex = arrayindex + 1
End If
Next Sheet
Разрешаем обновление
экрана
Application.ScreenUpdating = Тгие
Запоминаем имя созданной
книги результатов
Resu1tBook = ActiveWorkbook.Name 'Активизируем книгу с программой
Тhis Workbook.Activate
Выдаем результаты по
листам
For Each Sheet
In ActiveWorkbook.Worksheets Select Case Sheet.Name
Case
ListName(l) Sheet.Activate СаН
Text1lnput
СаН Tabll_Write(FMAX10,
FMAX40)
'Case
ListName(2)
'Sheet.Activate
'Сall Text2Input
'СаН Tabl2 _ Write(Optimum_ Sk1adO,
Optimum ]otrebitel())
'Case
ListName(4)
'Sheet.Activate
'СаН Text4Input
'СаН Tabl4_ Write(Optimum]owerFactoгyO)
'ase ListNаmе(З)
'Sheet.Activate
'СаН ТехtЗlnрut
End Select
Next Sheet
ActiveWorkbook.Save
'Сохранение рабочей
книги
'ActiveWorkbook.Close
'Закрытие книги
'Wогkshееts(ListNаmе(З )).Activate
'Очищаем StatusBar
Application.StatusBar
= False
End Sub
Sub
Text1Input()
Dim s, sl As
String
Dim Flag As
Integer
s= A1"
sl =
"L1"
Range(s,
sl).Select
With Selection
.HorizontalAlignment
= xlCenter
.VeгticalAlignment = xlCenter
.WrapText =
False
.Orientation =
О
.Addlndent =
False
.ShrinkToFit =
True
.MergeCeHs =
True
End With
With
ActiveWorkbook.ActiveSheet
.Range(s, s 1
).Font.Size = 16
.Range(s,
sl).Font.Bold = True
.Range(s,
sl).Font.Name = "Times New Roman"
End With
s= "А2"
sl =
"L2"
Range(s, s 1
).SeIect
With Selection
.HorizontalAlignment
= xlCenter
.VerticalAlignment
= xlCenter
.WrapText =
False
.Orientation =
О
.Addlndent =
False
.shrinkToFit =
True
End With
With
ActiveWorkbook.ActiveSheet
.Range(s,
sl).Font.Size = 12
.Range(s, s 1
).Fопt.воld = True
.Range(s,
sl).Font.Name = "Times New Roman"
End With
Range("Al
:Gl ").Select
ActiveCell.FormulaRICl
= "Результаты оптмизации "
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16
| 
