Sub obnov(gigi As String) 
 'Очередная мини программа без какого-либо интерфейса. Используется для обновления разбивок в таблице испытаний по Приобке... 
 'Таблица, в которой будут меняться разбивки, располагается на листе "Лист1", состоит из следующих колонок(в соответствующем порядке) 
 '1 имя скважины, альтитуда, удлинение 
 '2 пласт 
 '3 парные строки глубин/абсолюток залегания пласта (впрочем, в связи с обновлением данные по пластам не несут никакой смысловой нагрузки) 
 '4 парные строки глубин/абсолюток интервалов перфорации 
 '5 дебит нефти 
 '6 дебит воды/обводнённость 
 '7 примечание 
 'Новые разбивки на листе "Разбивки" (предполагается, что разбивки отсортированы по возрастанию глубин для каждой скважины) 
 '1 well 
 '2 surface 
 '3 Z 
 '4 MD 
 'Программа осуществляет копирование данных из исходной таблицы в открытый документ(в том же окне, что и "Обновление разбивок_form.xls"), названный в переменной gigi 
 'Особых косяков, вроде, не обнаружено, единственное, все примечания записываются вподряд, без привязки к дебитам+по дефолту читается одна строка с дебитом, а в разведочных _ 
 всякое бывает... И вообще, на разведочные побольше внимания... 
 'Шапка копируется до встречи в столбце "А" 1, т.е. строка с номерами столбцов обязательна 
 'И на последок... Прога адекватно работает только с адекватными исходными данными, т.е. косяки исходных данных остаются на своих местах 
  
 Dim indexar(1) As String    '0 количество строк, 1 имя скважины 
 Dim addpol(2, 10) As Byte   '0 Положение дебита, 1 положение комментариев 
 Dim smeshY As Byte          'Строки с шапкой таблицы 
  
 Dim str(30) As String       'Всякая хрень скопированная из таблицы 
 Dim indSTR As Byte          'Дополнительный индекс 
 Dim all_perf_TB(10, 1) As String 'Все интервалы перфорации, готовые к вставке в таблицу. all_perf_tb(10, 0) количество интервалов на данную скважину 
 Dim allPool(10, 15, 2) As String 'Интервалы пластов на данные интервалы перфорации 
 Dim bbb As Byte             'Счётчики 
 Dim rrr As Byte 
 Dim kkk As Byte 
  
  
  
  
 Application.ScreenUpdating = False 
 smeshY = 0 
  
 Workbooks("Обновление разбивок_form.xls").Activate 
 Sheets("Лист1").Select 
 Range("A1").Select 
  
     Cells.Replace What:=",", Replacement:=".", LookAt:=xlPart, SearchOrder _ 
         :=xlByRows, MatchCase:ъlse, SearchFormat:ъlse, ReplaceFormat:ъlse 'от греха по дальше замена запятых точками. 
  
  
 Do 
 smeshY = smeshY + 1 
 Loop While ActiveCell.Offset(smeshY - 1, 0) <> 1 
  
 Rows("1:" & smeshY).Copy 
     'Workbooks.Add 
     Workbooks(gigi).Activate 
     Sheets("new").Activate 
     ActiveSheet.Paste 
     Application.CutCopyMode = False                                         'Подавление запроса на очистку буфера обмена 
     Call format_do 
      
     Range("a" & smeshY + 1).Select 
  
 Workbooks("Обновление разбивок_form.xls").Activate 
 Sheets("Лист1").Select 
 Range("a" & smeshY + 1).Select 
  
 Do 
 indSTR = 0 
 Erase addpol 
 Erase all_perf_TB 
 Erase allPool 
  
 Call schet_strok(indexar, addpol) 
 If indexar(0) > 29 Then Exit Do 
 Call pr_copy(addpol, str) 
 Call getinterv(indexar, all_perf_TB) 
 If all_perf_TB(10, 0) <> "" Then Call pool(indexar, all_perf_TB, allPool) 
  
         Workbooks(gigi).Activate 
         Sheets("new").Activate 
          
         ActiveCell.Offset(0, 0) = str(0)                                                'Записаны имя скважины 
         ActiveCell.Offset(1, 0) = str(1)                                                '->>- альтитуда 
         ActiveCell.Offset(2, 0) = str(2)                                                '->>- удлинение 
         kkk = 0 
          
         If all_perf_TB(10, 0) <> "" Then 
             For bbb = 0 To all_perf_TB(10, 0) 
                 ActiveCell.Offset(0 + kkk, 3) = all_perf_TB(bbb, 0)                     'глубины перфорации 
                 ActiveCell.Offset(0 + kkk + 1, 3) = all_perf_TB(bbb, 1)                 'абсолютки перфорации 
                 For rrr = 0 To allPool(bbb, 15, 0) 
                     ActiveCell.Offset(0 + kkk + rrr * 2, 1) = allPool(bbb, rrr, 2)      'имя пласта 
                     ActiveCell.Offset(0 + kkk + rrr * 2, 2) = allPool(bbb, rrr, 0)      'глубины пласта 
                     ActiveCell.Offset(0 + kkk + rrr * 2 + 1, 2) = allPool(bbb, rrr, 1)  'абсолютки пласта 
                 Next rrr 
                  
                     If addpol(2, bbb) = 1 Then                                          'Если положение дебита и интервала перфорации совпали 
                         ActiveCell.Offset(0 + kkk, 4) = str(3 + indSTR * 3)             'Qn 
                         ActiveCell.Offset(0 + kkk, 5) = str(4 + indSTR * 3)             'Qw 
                         ActiveCell.Offset(1 + kkk, 5) = str(5 + indSTR * 3)             'Обводн 
                         indSTR = indSTR + 1 
                     End If 
                  
                 kkk = kkk + rrr * 2 
             Next bbb 
              
         Else 
                     For i = 1 To addpol(0, 0)                                           'Если нет интервалов перфорации вообще, то пишем дебиты по порядку 
                         ActiveCell.Offset(0 + kkk, 4) = str(0 + i * 3)                  'Qn 
                         ActiveCell.Offset(0 + kkk, 5) = str(1 + i * 3)                  'Qw 
                         ActiveCell.Offset(1 + kkk, 5) = str(2 + i * 3)                  'Обводн 
                         kkk = kkk + 2 
                     Next i 
                  
         End If 
              
         For bbb = 1 To addpol(1, 0)                                                     'Запись примечаний, тупо по порядку 
             ActiveCell.Offset(bbb - 1, 6) = str(2 + bbb + addpol(0, 0) * 3) 
         Next bbb 
          
         If kkk < 3 Then kkk = 3                                                         'Количество строк на скважину в новой таблице 
          
         Call format_table(kkk) 
         ActiveCell.Offset(kkk, 0).Select 
         Workbooks("Обновление разбивок_form.xls").Activate 
         Sheets("Лист1").Select 
         ActiveCell.Offset(indexar(0), 0).Select 
 Loop While indexar(0) <> "Пока рак на горе не свиснет!"                                  'гы, условие никогда не выполнится, да и не надо, прерывание внутри цикла 
  
 Workbooks(gigi).Save 
  
 Application.ScreenUpdating = True 
 End Sub 
  
 Sub schet_strok(ByRef indexar() As String, ByRef addpol() As Byte) 
 'Эх, руки бы оборвать этому программисту, _ 
 Но у нас с покон веков _ 
 Нет суда на дураков... 
  
 Dim well As String                  'Переменная в которую считываются поля из столбца с номерами скважин 
 Dim strWell As Integer              'Число строк на скважину 
 Dim kui As Byte                     'Счётчик, используется для посимвольного чтения номера скважин 
 Dim wellNumber As Integer           'Номер скважины, если повезёт... 
 Dim t As Byte                       'Числовой код первого\последнего символа в переменной well 
 Dim proVer_na_text As Boolean       'проверка на наличие текста в названии скважины 
 Dim tekSTR As Integer               'Текущее положение номера скважины 
 Dim numINT As Byte                  'Номер интервала перфорации 
 Dim hj As Byte 
 'ReDim indexar(1) 
 'ReDim addpol(0,10) 
 lll = 0 
 addpol(0, 0) = 0 
 addpol(1, 0) = 0 
 tekSTR = -1 
 strWell = -1 
  
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Модуль для счёта строк на скважину'''''''''''''''''''''''''''''''''''''''''''''''''' 
         Do 
                 kui = 1 
                 wellNumber = 0 
                 strWell = strWell + 1 
                 well = ActiveCell.Offset(strWell, 0) 
                  
             If strWell - tekSTR > 30 Then indexar(0) = 20: Exit Do  'Выход по постижении конца таблицы+пометка для завершения глобального цикла 
                 If ActiveCell.Offset(strWell, 4) <> "" Then 
                     addpol(0, 0) = addpol(0, 0) + 1 
                     addpol(0, addpol(0, 0)) = strWell 
                 End If 
                  
                 If ActiveCell.Offset(strWell, 6) <> "" Then 
                     addpol(1, 0) = addpol(1, 0) + 1 
                     addpol(1, addpol(1, 0)) = strWell 
                 End If 
                  
                 If ActiveCell.Offset(strWell, 3) <> "" Then numINT = numINT + 1 
                 If ActiveCell.Offset(strWell, 3) <> "" And ActiveCell.Offset(strWell, 4) <> "" Then addpol(2, (numINT - 1) / 2) = 1 
                  
   
                  
                  
                  
                         If well <> "" Then 
                          
                                      
                                     t = Asc(Left(well, 1)) 
                                     If (t > 64 And t < 91) Or (t > 96 And t < 123) Or (t > 191 And t <= 255) Then Exit Do      'проверка на текст в начале поля скв. 
                              
                              
                                     Do While kui <= Len(well) 
                                     If (Asc(Mid(well, kui, 1)) < 48 Or Asc(Mid(well, kui, 1)) > 57) Then Exit Do 'Чтение номера скважины, который заведомо больше 
                                     wellNumber = wellNumber & Mid(well, kui, 1)                                                'альтитуды и удлинения 
                                     kui = kui + 1 
                                     Loop 
                                      
                         End If 
                          
         Loop While wellNumber < 10000 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  
 indexar(1) = well 
 If wellNumber > 10000 Then indexar(1) = wellNumber 
 If Len(well) > 5 Then 
     If wellNumber > 10000 And Asc(Mid(well, 6, 1)) <> 98 Then indexar(1) = wellNumber 
     If wellNumber > 10000 And Asc(Mid(well, 6, 1)) = 98 Then indexar(1) = Left(well, 6) 
 End If 
  
  
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Модуль для счёта строк на скважину'''''''''''''''''''''''''''''''''''''''''''''''''' 
         Do 
                 kui = 1 
                 wellNumber = 0 
                 strWell = strWell + 1 
                 well = ActiveCell.Offset(strWell, 0) 
                  
             If strWell - tekSTR > 30 Then indexar(0) = 20: Exit Do  'Выход по постижении конца таблицы+пометка для завершения глобального цикла 
  
   
                         If well <> "" Then 
                          
                                      
                                     t = Asc(Left(well, 1)) 
                                     If (t > 64 And t < 91) Or (t > 96 And t < 123) Or (t > 191 And t <= 255) Then Exit Do      'проверка на текст в начале поля скв. 
                              
                              
                                     Do While kui <= Len(well) 
                                     If (Asc(Mid(well, kui, 1)) < 48 Or Asc(Mid(well, kui, 1)) > 57) Then Exit Do 'Чтение номера скважины, который заведомо больше 
                                     wellNumber = wellNumber & Mid(well, kui, 1)                                                'альтитуды и удлинения 
                                     kui = kui + 1 
                                     Loop 
                                      
                         End If 
                          
                          
                          
                          
                          
                          
                          
                 If ActiveCell.Offset(strWell, 4) <> "" And wellNumber < 10000 Then 
                     addpol(0, 0) = addpol(0, 0) + 1 
                     addpol(0, addpol(0, 0)) = strWell 
                 End If 
                  
                 If ActiveCell.Offset(strWell, 6) <> "" And wellNumber < 10000 Then 
                     addpol(1, 0) = addpol(1, 0) + 1 
                     addpol(1, addpol(1, 0)) = strWell 
                 End If 
                  
                 If ActiveCell.Offset(strWell, 3) <> "" Then numINT = numINT + 1 
                 If ActiveCell.Offset(strWell, 3) <> "" And ActiveCell.Offset(strWell, 4) <> "" And wellNumber < 10000 Then addpol(2, (numINT - 1) / 2) = 1 
                  
  
         Loop While wellNumber < 10000 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
 indexar(0) = strWell 
 End Sub 
  
 Sub temp() 
 Workbooks.Add 
 ActiveSheet.Paste 
 Application.CutCopyMode = False                                         'Подавление запроса на очистку буфера обмена 
 gigi = "Таблица испытаний с разбивками на " & Date & ".xls" 
     ActiveWorkbook.SaveAs Filename:= _ 
         gigi, FileFormat _ 
         :=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ 
         False, CreateBackup:ъlse                                                  'Сохранение новой книги с именем текущей даты 
 End Sub 
 Sub pr_copy(addpol, ByRef str() As String) 
 Dim i As Byte 'Тупо счётчик 
  
 str(0) = ActiveCell.Offset(0, 0) 
 str(1) = ActiveCell.Offset(1, 0) 
 str(2) = ActiveCell.Offset(2, 0) 
  
 For i = 1 To addpol(0, 0) 
  
 str(0 + i * 3) = ActiveCell.Offset(addpol(0, i), 4) 
 str(1 + i * 3) = ActiveCell.Offset(addpol(0, i), 5) 
 str(2 + i * 3) = ActiveCell.Offset(addpol(0, i) + 1, 5) 
 m = m + 1 
 Next i 
  
 For i = 1 To addpol(1, 0) 
 str(2 + i + addpol(0, 0) * 3) = ActiveCell.Offset(addpol(1, i), 6) 
 Next i 
  
 End Sub 
  
 Sub getinterv(indexar, ByRef all_perf_TB() As String) 
 'Модуль сичтывает ВСЕ интервалы перфорации на данную скважину. 
 'Входной аргумент должен содержать количество строк, приходящихся на данную скважину 
 'Выходной пердставляет собой двумерный массив, где первый индекс - номер интервала, второй 0-глубины,1абсолютки. Все интервалы перфорации в текстовом формате. 
 'all_perf_tb(10, 0) количество интервалов на данную скважину 
  
 Dim numstr As Byte      'Номер строки относительно ячейки с номером скважины 
 Dim numINTperf As Byte  'Номер интервала перфорации 
 'Dim dbl_TB(1) As Double 'кровля/подошва в глубинах 
 Dim str_TB(1) As String 'Глубины/абсолютки перфорации 
 'Dim all_perf_tb(10, 1) As String 'Все интервалы перфорации, готовые к вставке в таблицу 
  
 numINTperf = 0 
 For numstr = 0 To indexar(0) - 1 
  
         If ActiveCell.Offset(numstr, 3) <> "" Then 
             'Erase dbl_TB(1) 
             Erase str_TB 
             Call interv(numstr, str_TB) 
             numstr = numstr + 1 
             all_perf_TB(numINTperf, 0) = str_TB(0) 
             all_perf_TB(numINTperf, 1) = str_TB(1) 
             numINTperf = numINTperf + 1 
         End If 
  
 Next numstr 
  
 If numINTperf > 1 Then 
 all_perf_TB(10, 0) = numINTperf - 1 
 ElseIf numINTperf = 1 Then all_perf_TB(10, 0) = "0" 
 Else: all_perf_TB(10, 0) = "" 
 End If 
  
 End Sub 
  
 Sub interv(numstr, str_topBOT() As String) 
  
 'Данный модуль считывает значение кровли/подошвы интервала перфорации. 
 'Входной аргумент - положение ячейки с глубиной интервала перфорации относительно ячейки с текущим номером скважины. 
 'Выходные аргументы: _ 
                         str_topBOT()-0 форматированный интервал перфорации в глубинах, 1 ->>- в абсолютках 
                          
                          
 'ByRef dbl_topBOT() As Double, 
 'dbl_topBOT()-0 кровля, 1 подошва интервала перфорации в глубинах _ была такая вот мысля, но что-то отказался... 
  
 Dim kg_am As Byte       'текущее положение чтения символа 
 'Dim dbl_topBOT(1) As Double '0 кровля, 1 подошва 
 Dim tmpTB As String 
 Dim dlin_str As Byte 'Длина строковой переменной 
 Dim ttt As Byte 
 'Dim str_topBOT(1) As String 
  
  
 tmpTB = "" 
 For ttt = 0 To 1 
         dlin_str = Len(ActiveCell.Offset(numstr + ttt, 3)) 
             If dlin_str > 0 Then 
                 kg_am = 1 
                 Do While (Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) > 47 And Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) < 58) _ 
                 Or Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) = 44 _ 
                 Or Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) = 46 
                         tmpTB = tmpTB & Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1) 
                         kg_am = kg_am + 1 
                         If kg_am > dlin_str Then Exit Do 
                 Loop 
                  
                             If kg_am = 7 Then 
                                 str_topBOT(ttt) = tmpTB 
                             ElseIf kg_am = 5 Then 
                                 str_topBOT(ttt) = tmpTB & ".0" 
                             ElseIf kg_am > 7 Then 
                                 str_topBOT(ttt) = Left(tmpTB, 6) 
                             ElseIf kg_am = 6 Then 
                                 str_topBOT(ttt) = tmpTB & "0" 
                             Else 
                                 str_topBOT(ttt) = "Косяк!" 
                             End If 
                  
                 'If ttt < 1 Then dbl_topBOT(0) = CDbl(tmpTB)                            'Кровля 
                 tmpTB = "" 
                         Do Until Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) > 47 And Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) < 58 
                             kg_am = kg_am + 1 
                             If kg_am > dlin_str Then GoTo 1 
                         Loop 
                          
                 Do While (Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) > 47 And Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) < 58) _ 
                 Or Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) = 44 _ 
                 Or Asc(Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1)) = 46 
                         tmpTB = tmpTB & Mid(ActiveCell.Offset(numstr + ttt, 3), kg_am, 1) 
                         kg_am = kg_am + 1 
                         If kg_am > dlin_str Then Exit Do 
                 Loop 
                  
 1                kg_am = Len(tmpTB) + 1        'Не судите строго люди, но так надо для удобства... Тут кг_ам уже не положение символа, а дляна переменной tmpTB 
                             If kg_am = 7 Then 
                                 str_topBOT(ttt) = str_topBOT(ttt) & "-" & tmpTB 
                             ElseIf kg_am = 5 Then 
                                 str_topBOT(ttt) = str_topBOT(ttt) & "-" & tmpTB & ".0" 
                             ElseIf kg_am > 7 Then 
                                 str_topBOT(ttt) = str_topBOT(ttt) & "-" & Left(tmpTB, 6) 
                             ElseIf kg_am = 6 Then 
                                 str_topBOT(ttt) = str_topBOT(ttt) & "-" & tmpTB & "0" 
                             Else 
                                 str_topBOT(ttt) = str_topBOT(ttt) & "-" & "Косяк!" 
                             End If 
                  
                 'If ttt < 1 Then dbl_topBOT(1) = CDbl(tmpTB)                            'Подошва 
                 tmpTB = "" 
                  
             End If 
 Next ttt 
  
 End Sub 
 Sub pool(indexar, all_perf_TB, ByRef allPool) 
 Dim ggg As Byte 'Счётчик 
 Dim smeshY  As Byte                 'Смещение при поиске интервала пласта на листе с разбивками 
 Dim indPOOL As Byte                 'Индекс в pool 
 Dim tmp As Boolean 
  
 On Error Resume Next 
  
        Sheets("Разбивки").Select                                                                   'Поиск скважины на листе с разбивками 
 For ggg = 0 To all_perf_TB(10, 0) 
 If Left(all_perf_TB(ggg, 0), 6) <> "Косяк!" And Right(all_perf_TB(ggg, 0), 6) <> "Косяк!" Then 
         Range("a1").Select 
             Cells.Find(What:=indexar(1), After:¬tiveCell, LookIn:=xlFormulas, LookAt _ 
             :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
             False, SearchFormat:ъlse).Activate                                                        'Найдена Скважина 
     If CStr(ActiveCell.Offset(0, 0)) Like indexar(1) Then 
      
     smeshY = 0                    'Обнуление смещения относительно первоначально встретившийся ячейки с номером скважины 
                                        Do While ActiveCell.Offset(smeshY, 3) - Left(all_perf_TB(ggg, 0), 6) < 2 And CStr(ActiveCell.Offset(smeshY, 0)) Like indexar(1)      'Цикл в поисках кровли пласта, который проперфорирован 
                                            smeshY = smeshY + 1 
                                        Loop 
                                         
                                     indPOOL = 0 
                                     Do 
                                            allPool(ggg, indPOOL, 2) = ActiveCell.Offset(smeshY - 1, 1)                                         'Записано имя пласта 
      
                                            allPool(ggg, indPOOL, 0) = ActiveCell.Offset(smeshY - 1, 3)                                     '->>- кровля(MD) 
                                            If Len(ActiveCell.Offset(smeshY - 1, 3)) = 4 Then allPool(ggg, indPOOL, 0) = allPool(ggg, indPOOL, 0) & ".0"    'Наведение красоты 
                                            If CStr(ActiveCell.Offset(smeshY, 0)) Like indexar(1) Then                                    'Проверка, чтоб не выскочить ниже проинтерпретированных интервалов 
                                                 allPool(ggg, indPOOL, 0) = allPool(ggg, indPOOL, 0) & -ActiveCell.Offset(smeshY, 3)                        'Подошва (MD) 
                                                 If Len(ActiveCell.Offset(smeshY, 3)) = 4 Then allPool(ggg, indPOOL, 0) = allPool(ggg, indPOOL, 0) & ".0"   'Наведение красоты 
                                            Else: allPool(ggg, indPOOL, 0) = allPool(ggg, indPOOL, 0) & "-н.д."                                            'Если проперфорировано ниже интерпретации, то "нет данных", т.е. "н.д." 
                                            End If 
      
                                            allPool(ggg, indPOOL, 1) = -ActiveCell.Offset(smeshY - 1, 2)                                            'Блок полностью аналогичен, представленному выше, только здесь пишутся абсолютки 
                                            If Len(ActiveCell.Offset(smeshY - 1, 2)) = 5 Then allPool(ggg, indPOOL, 1) = allPool(ggg, indPOOL, 1) & ".0" 
                                            If CStr(ActiveCell.Offset(smeshY, 0)) Like indexar(1) Then 
                                                 allPool(ggg, indPOOL, 1) = allPool(ggg, indPOOL, 1) & ActiveCell.Offset(smeshY, 2) 
                                                 If Len(ActiveCell.Offset(smeshY, 2)) = 5 Then allPool(ggg, indPOOL, 1) = allPool(ggg, indPOOL, 1) & ".0" 
                                            Else: allPool(ggg, indPOOL, 1) = allPool(ggg, indPOOL, 1) & "-н.д." 
                                            End If 
                                             
                                            smeshY = smeshY + 1       'Перешли к следующему пласту 
                                            indPOOL = indPOOL + 1     'Прибавили индекс 
  
                                     Loop While ActiveCell.Offset(smeshY - 1, 3) - Right(all_perf_TB(ggg, 0), 6) < 1 And CStr(ActiveCell.Offset(smeshY - 1, 0)) Like indexar(1) 'Цикл продолжается до тех пор, пока подошва последнего пласта выше подошвы интервала перфорации, и совпадают номера скважин 
      
     End If 
 End If 
 If indPOOL > 0 Then 
 allPool(ggg, 15, 0) = indPOOL - 1 
 Else: allPool(ggg, 15, 0) = 0 
 End If 
 Next ggg 
  
 End Sub 
 Sub format_table(kkk) 
  
 Dim Xsmesh As Byte                  'Счётчик для For 
 Dim Ysmesh As Byte                  'Счётчик для For 
  
 '''''''''''''''''''''''''''''''''Толстая верхняя граница+центровка''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     For Xsmesh = 0 To 7 
          
         For Ysme ... 
 

 
 ... sh = 0 To kkk - 1 
      
                 'With ActiveCell.Offset(Ysmesh, Xsmesh).Borders(xlEdgeLeft) 
                 '    .LineStyle = xlContinuous 
                 '    .ColorIndex = 0 
                 '    .TintAndShade = 0 
                 '    .Weight = xlMedium 
                 'End With 
                  
      
             If (Ysmesh = 0 And Xsmesh <> 7) Or (ActiveCell.Offset(Ysmesh, 4) <> "" And Xsmesh > 0 And Xsmesh < 6) And (Ysmesh Mod 2) = 0 Then 
                 With ActiveCell.Offset(Ysmesh, Xsmesh).Borders(xlEdgeTop) 
                     .LineStyle = xlContinuous 
                     .ColorIndex = 0 
                     .TintAndShade = 0 
                     .Weight = xlMedium 
                 End With 
              End If 
               
             If Xsmesh = 7 And Ysmesh = kkk - 1 Then Exit For 
                  
                 'With ActiveCell.Offset(Ysmesh, Xsmesh) 
                 '    .HorizontalAlignment = xlCenter 
                 '    .VerticalAlignment = xlCenter 
                 '    .WrapText = True 
                 '    .Orientation = 0 
                 '    .AddIndent = False 
                 '    .IndentLevel = 0 
                 '    .ShrinkToFit = False 
                 '    .ReadingOrder = xlContext 
                 '    .MergeCells = False 
                 'End With 
                  
         Next Ysmesh 
          
     Next Xsmesh 
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  
  
     Selection.NumberFormat = "@" 
     ActiveCell.Offset(1, 0).NumberFormat = "0.0" 
     ActiveCell.Offset(2, 0).NumberFormat = "0.0" 
     ActiveCell.Offset(0, 1).NumberFormat = "@" 
  
      
      
 '''''''''''''''''''''''''''''''''''''''Подчёркивания'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     For Xsmesh = 2 To 3 
         For Ysmesh = 0 To kkk - 1 
             ActiveCell.Offset(Ysmesh, Xsmesh).NumberFormat = "@" 
             ActiveCell.Offset(Ysmesh, Xsmesh).Font.Underline = xlUnderlineStyleNone 
             If Ysmesh Mod 2 = 0 Then ActiveCell.Offset(Ysmesh, Xsmesh).Font.Underline = xlUnderlineStyleSingle 
         Next Ysmesh 
     Next Xsmesh 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  
      
 ''''''''''''''''''''''''''''''''''''''''Дебиты'''''''''''''''''' 
     For Ysmesh = 0 To kkk Step 2 
         ActiveCell.Offset(Ysmesh, 4).NumberFormat = "0.00" 
         ActiveCell.Offset(Ysmesh, 5).NumberFormat = "0.00" 
         ActiveCell.Offset(Ysmesh + 1, 5).NumberFormat = "0.00%" 
     Next Ysmesh 
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
  
 End Sub 
 Sub format_do() 
 Columns("A:a").Select 
     Selection.ColumnWidth = 11 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
    Columns("b:b").Select 
    Selection.ColumnWidth = 10 
    With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("C:c").Select 
     Selection.ColumnWidth = 15 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("D:d").Select 
     Selection.ColumnWidth = 15 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("E:e").Select 
     Selection.ColumnWidth = 10 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("f:F").Select 
     Selection.ColumnWidth = 10 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("G:G").Select 
     Selection.ColumnWidth = 12 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("h:h").Select 
     With Selection.Borders(xlEdgeLeft) 
         .LineStyle = xlContinuous 
         .ColorIndex = 0 
         .TintAndShade = 0 
         .Weight = xlMedium 
     End With 
      
     Columns("a:G").Select 
      
     With Selection 
         .HorizontalAlignment = xlCenter 
         .VerticalAlignment = xlCenter 
     End With 
 End Sub