Attribute VB_Name = "finteh"
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
        (ByVal hKey As Long, ByVal dwIndex As Long, _
        ByVal lpName As String, _
        ByVal cbName As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, _
        ByVal ulOptions As Long, ByVal samDesired As Long, _
        phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Const KEY_QUERY_VALUE = &H8
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_SUCCESS = 0&
Global Const ERROR_NO_MORE_ITEMS = 259
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Type arrType
    data() As String
    Razdel() As String
    flag As Boolean
End Type
Public letArr() As arrType

Public repFileNameF As String, sheetF As Worksheet

Public Sub FINTEH_UPDATE()
Dim saveBookName As String, i As Variant, name As String, dlg As CommonDialog
Dim path As String

'    Set dlg = New CommonDialog
'
'    dlg.Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt|Batch Files (*.bat)|*.bat"
'    dlg.FilterIndex = 2
'
'    dlg.ShowOpen
    
    Call init_data
    path = "c:\finteh\"
    repFileNameF = "C:\UPD_FINTEH.TXT"
    
    Open repFileNameF For Output As #1
    
    Set sheetF = Sheets.Add
    
    Application.StatusBar = " Обновление бланка раздела " + Sheets("Service").Range("B19").Text
    Call UPD_STR_F(path, Sheets("Service").Range("B19").Text)
    
'    Application.StatusBar = " Обновление формул раздела " + Sheets("Service").Range("B19").Text
'    Call UPD_FORM_F(path, Sheets("Service").Range("B19").Text)
    
    Application.DisplayAlerts = False
    sheetF.Delete
    Application.DisplayAlerts = True
    
    Close #1
    
    Call MsgBox("Обновление бланка раздела " + Sheets("Service").Range("B19").Text + " завершено !", vbOKOnly, "Обновление бланка")
    
End Sub

' mode =0 - link, иначе номер строки
Public Function getFintehLink(kl As Integer, kst As Integer, Optional mode As Integer = 0)
Dim kritRow As Integer, kritCol As Integer
Dim sheetsReport
Dim LookRange

    kritRow = Sheets("Service").Range("KRIT_CODE").row
    kritCol = Sheets("Service").Range("KRIT_CODE").column

    Set sheetsReport = Sheets(Sheets("Service").Range("B19").Text)
    Sheets("Service").Cells(kritRow + 1, kritCol) = kl 'KL
    Sheets("Service").Cells(kritRow + 1, kritCol + 1) = kst 'KST
    If Sheets("Service").Cells(kritRow + 1, kritCol - 1) = 0 Then
        getFintehLink = Sheets("Service").Cells(kritRow, kritCol - 1)
        If mode <> 0 Then
            Set LookRange = sheetsReport.Range("LINK").Find(Sheets("Service").Cells(kritRow, kritCol - 1), LookIn:=xlFormulas, lookat:=xlWhole)
            If Not LookRange Is Nothing Then
                getFintehLink = LookRange.row
            Else
                getFintehLink = 0
            End If
        End If
    Else
        getFintehLink = 0
    End If

End Function

Public Sub BlankUpdate_F(Optional path As String = "c:\finteh\")
Dim saveBookName As String, i As Variant, name As String
    
    Call init_data
    repFileNameF = "C:\UPD_FINTEH.TXT"
    
    Open repFileNameF For Output As #1
    
    Set sheetF = Sheets.Add
    
    Sheets("Отчет").Select
    Call UPD_STR_F(path, "Отчет")
    
    Application.DisplayAlerts = False
    sheetF.Delete
    Application.DisplayAlerts = True
    
    Set sheetF = Sheets.Add
    
    Sheets("Справочная_таблица").Select
    Call UPD_STR_F(path, "Справочная_таблица")
    
    Application.DisplayAlerts = False
    sheetF.Delete
    Application.DisplayAlerts = True
    
    Set sheetF = Sheets.Add
    
    Sheets("Отчет").Select
    Call UPD_FORM_F(path, "Отчет")

    Sheets("Справочная_таблица").Select
    Call UPD_FORM_F(path, "Справочная_таблица")
    
'    Call UPD_MDC_F(path)
    
    Application.DisplayAlerts = False
    sheetF.Delete
    Application.DisplayAlerts = True
    
    Close #1
End Sub
    
Public Sub UPD_MDC_F(path As String)
Dim fName As String, fieldsList As String, strCount As Integer, fCol As Integer, j As Integer, tempStr As String
Dim i As Integer, k As Integer, nameCol As Integer
Dim codeCol, workFlag As Boolean
Dim mode As Integer, fNum As Integer
Dim klCol As Integer, kstCol As Integer
Dim page(2) As String, page51 As String, actPage As Integer


    fieldsList = "nom, kform1, kl1, kst1, znak, kgr1 "
    tempStr = "ORDER BY nom ASC"
    
    page(1) = "Отчет"
    page(2) = "Справочная_таблица"
        
    Print #1, "Обновление формул междокументального контроля "

    strCount = LoadData(path + "mdk.dbf", fieldsList, sheetF, tempStr)
    
    j = 2
    fNum = sheetF.Cells(j, 1)
    
'    'почистим лажу
'    While VBA.Trim(sheetF.Cells(j, 1).Text) <> ""
'
'    Wend
'
'    j = 2
'    fNum = sheetF.Cells(j, 1)
    
    Call readLetterData
    
    tempStr = ""
    While j <= strCount + 1
        Application.StatusBar = "Обновление формул междокументального контроля: строка" + VBA.str(j) + " из " + VBA.str(strCount + 1)
        
        If sheetF.Cells(j, 2) = 50 Then
            actPage = 50
        Else
            actPage = 51
        End If
        Sheets(page(IIf(actPage = 50, 1, 2))).Activate
        
        tempStr = sheetF.Cells(j, 3).Text + " " + sheetF.Cells(j, 4).Text + " " + sheetF.Cells(j, 6).Text
        tempStr = tempStr + " " + sheetF.Cells(j, 5).Text + " "
        workFlag = False
        j = j + 1
        While fNum = sheetF.Cells(j, 1)
            If sheetF.Cells(j, 2) = actPage Then
                tempStr = tempStr + " " + sheetF.Cells(j, 3).Text + " " + sheetF.Cells(j, 4).Text + " " + sheetF.Cells(j, 6).Text + " " + sheetF.Cells(j, 5).Text
            Else
                workFlag = True
                tempStr = tempStr + " " + page(IIf(sheetF.Cells(j, 2) = 50, 1, 2)) + " " + sheetF.Cells(j, 3).Text + " " + sheetF.Cells(j, 4).Text + " " + sheetF.Cells(j, 6).Text + " " + sheetF.Cells(j, 5).Text
            End If
            j = j + 1
        Wend
        If workFlag Then
            tempStr = Replace_in_Str(tempStr, "!", ">=")
            Call addForm_mdc(tempStr, sheetF.Cells(j, 2)) 'лист, kl,kst,column,znak
        End If
        fNum = sheetF.Cells(j, 1)
    Wend

End Sub
    
Public Sub UPD_FORM_F(path As String, pageName As String)
Dim fName As String, fieldsList As String, strCount As Integer, fCol As Integer, j As Integer, tempStr As String
Dim i As Integer, k As Integer, nameCol As Integer
Dim codeCol, deleteFlag As Boolean
Dim mode As Integer, fNum As Integer
Dim klCol As Integer, kstCol As Integer

    fieldsList = "nom, kl, kst, kbk, znak, vidf"
    tempStr = "ORDER BY nom ASC"
    
    Select Case pageName
        Case "Отчет"
            fName = "vk050.DBF"
            mode = 1
        Case "Справочная_таблица"
            fName = "vk051.DBF"
            mode = 2
    End Select
    
        
    Print #1, "Обновление формул раздела '" + pageName + "':"

    'Временное снятие защиты
    Sheets(pageName).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
    
    Sheets(pageName).Select
    fCol = Sheets(pageName).Range("FINTEH_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    klCol = Sheets(pageName).Range("KL_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    kstCol = Sheets(pageName).Range("KST_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    
    nameCol = Sheets("Service").Range("C6") - Sheets("Service").Range("E5")
    codeCol = Sheets("Service").Range(Sheets("Service").Range("E1").Text)
    
    strCount = LoadData(path + fName, fieldsList, sheetF, tempStr)
    
    Sheets(pageName).Activate
    
    j = 2
    fNum = sheetF.Cells(j, 1)
    
    tempStr = ""
    While j <= strCount + 1
        Application.StatusBar = "Обновление формул: строка" + VBA.str(j) + " из " + VBA.str(strCount + 1)
        tempStr = sheetF.Cells(j, 2).Text + " " + sheetF.Cells(j, 3).Text '+ IIf(pageName = "Справочная_таблица", VBA.Right("00" + VBA.Trim(sheetF.Cells(j, 3).Text), 2), "")
        tempStr = tempStr + " " + sheetF.Cells(j, 5).Text + " "
        j = j + 1
        While fNum = sheetF.Cells(j, 1)
            tempStr = tempStr + " " + sheetF.Cells(j, 5).Text + " " + sheetF.Cells(j, 2).Text + " " + sheetF.Cells(j, 3).Text '+ sheetF.Cells(j, 4).Text + IIf(pageName = "Справочная_таблица", VBA.Right("00" + VBA.Trim(sheetF.Cells(j, 3).Text), 2), "")
            j = j + 1
        Wend
        tempStr = Replace_in_Str(tempStr, "!", ">=")
        Call addForm(tempStr, sheetF.Cells(j, 2))
        fNum = sheetF.Cells(j, 1)
    Wend
    
End Sub
Public Sub UPD_STR_F(path As String, pageName As String)
Dim fName As String, fieldsList As String, strCount As Integer, fCol As Integer, j As Integer, tempStr As String
Dim i As Integer, k As Integer, nameCol As Integer
Dim codeCol, deleteFlag As Boolean
Dim mode As Integer
Dim klCol As Integer, kstCol As Integer
Dim saveMax As Integer

    fieldsList = "kl, kst, kbk, n2"
    
    Select Case pageName
        Case "Отчет"
            fName = "SS02050.DBF"
            mode = 1
        Case "Справочная_таблица"
            fName = "SS02051.DBF"
            mode = 2
    End Select
    
    Print #1, "Обновление бланка раздела '" + pageName + "':"
    
    'Временное снятие защиты
    Sheets(pageName).Select
    Sheets(pageName).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
    
    Application.ScreenUpdating = False
    
    fCol = Sheets(pageName).Range("FINTEH_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    klCol = Sheets(pageName).Range("KL_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    kstCol = Sheets(pageName).Range("KST_" + VBA.Trim(VBA.str(Sheets("Service").Range("B20")))).column
    
    nameCol = Sheets("Service").Range("C6") - Sheets("Service").Range("E5")
    codeCol = Sheets("Service").Range(Sheets("Service").Range("E1").Text)
    
    strCount = LoadData(path + fName, fieldsList, sheetF, " order by kl, kst")
    
    Sheets(pageName).Activate
    
    deleteFlag = False
    Print #1, "Список лишних строк:"
    If strCount <> 0 Then
        ' Шаг 1 - ПРОВЕРКА
        saveMax = Sheets("Service").Range("A9")
        For j = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
            Application.StatusBar = "Проверка существующих строк: строка" + VBA.str(j) + " из " + VBA.str(saveMax)
            If Sheets(pageName).Cells(j, 1) <> 0 Then
                tempStr = VBA.Trim(getFullCode(j))
                For i = 2 To strCount + 1
                    If mode = 1 Then
                        If tempStr = VBA.Trim(sheetF.Cells(i, 3)) And Sheets(pageName).Cells(j, 2) = sheetF.Cells(i, 1) Then
                            Sheets(pageName).Cells(j, fCol) = sheetF.Cells(i, 2)
                            Sheets(pageName).Cells(j, nameCol) = VBA.Trim(sheetF.Cells(i, 4)) 'convert_dos_win(sheetF.Cells(i, 4),0)
                            
                            Sheets(pageName).Rows(j).AutoFit
                            sheetF.Rows(i).Interior.ColorIndex = 4 '.Delete
                            'strCount = strCount - 1
                            'Sheets(pageName).Cells(j, 3).Interior.ColorIndex = 4
                            GoTo nnn
                        End If
                    Else
                        If tempStr = IIf(VBA.Len(VBA.Trim(sheetF.Cells(i, 3))) > 4, VBA.Left(VBA.Trim(sheetF.Cells(i, 3)) + "    ", 10), VBA.Trim(sheetF.Cells(i, 3)) + "000") + VBA.Trim(VBA.Right("00" + VBA.Trim(sheetF.Cells(i, 1).Text), 3)) Then ' And Sheets(pageName).Cells(j, 2) = sheetF.Cells(i, 1)
                            Sheets(pageName).Cells(j, kstCol) = sheetF.Cells(i, 2)
                            Sheets(pageName).Cells(j, nameCol) = VBA.Trim(sheetF.Cells(i, 4)) 'VBA.Trim(sheetF.Cells(i, 4))
                            
                            Sheets(pageName).Rows(j).AutoFit
                            sheetF.Rows(i).Interior.ColorIndex = 4 '.Delete
                            'strCount = strCount - 1
                            'Sheets(pageName).Cells(j, 3).Interior.ColorIndex = 4
                            GoTo nnn
                        End If
                    End If
                Next
                ' ничего не нашли
                Sheets(pageName).Cells(j, 3).Interior.ColorIndex = 3
                Sheets(pageName).Cells(j, fCol) = ""
                Print #1, "   " + getCode(j) + "  " + Sheets(pageName).Cells(j, nameCol)
                deleteFlag = True
nnn:
            End If
        Next
        Application.StatusBar = ""
        
        If deleteFlag = True Then
            If MsgBox("В разделе '" + pageName + "' обнаружены строки, которых нет в бланке финтеха. Удалить их автоматически?", vbQuestion + vbYesNo, "Внимание !") = vbYes Then
                Print #1, "Список удаленных строк:"
                j = Sheets("Service").Range("C5")
                While j <= Sheets("Service").Range("A9")
                    If Sheets(pageName).Cells(j, 3).Interior.ColorIndex = 3 Then
                        Print #1, "   " + getCode(j) + "  " + Sheets(pageName).Cells(j, nameCol)
                        Call READDRESS_FORMULA(j, False)
                        Sheets(pageName).Rows(j).Delete
                        Sheets("Service").Range("A9") = Sheets("Service").Range("A9") - 1
                        j = j - 1
                    End If
                    j = j + 1
                Wend
                
            End If
        End If
            
        ' Шаг 2 - ДОБАВЛЕНИЕ
        Print #1, "Список добавленных строк:"
        saveMax = strCount
        For i = 2 To strCount + 1
            Application.StatusBar = "Добавление строк: строка " + VBA.str(i) + " из " + VBA.str(saveMax)
            If sheetF.Rows(i).Interior.ColorIndex <> 4 Then ' идем сверху sheetF.Cells(i, 2) > 1
                For j = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
                    If mode = 1 Then
                        If Sheets(pageName).Cells(j, fCol) = sheetF.Cells(i - 1, 2) And Sheets(pageName).Cells(j, 2) = sheetF.Cells(i, 1) Then
                            'снять защиту
                            Sheets(pageName).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                            Sheets(pageName).Rows(j + 1).Insert
                            Sheets(pageName).Cells(j + 1, 1) = Sheets(Sheets("service").Range("B19").Text).Range("A1") + 1
                            Sheets(pageName).Cells(j + 1, 2) = Sheets(pageName).Cells(j + 2, 2)
                            
                            Sheets(pageName).Cells(j + 1, fCol) = sheetF.Cells(i, 2)
                            Sheets(pageName).Cells(j + 1, nameCol) = VBA.Trim(sheetF.Cells(i, 4)) 'VBA.Trim(sheetF.Cells(i, 4))
                            Sheets(pageName).Cells(j + 1, codeCol) = sheetF.Cells(i, 3)
                            
                            Sheets(pageName).Rows(j + 1).AutoFit
                            sheetF.Rows(i).Interior.ColorIndex = 5
                            strCount = strCount - 1
                            Sheets(pageName).Cells(j + 1, 3).Interior.ColorIndex = 5
                            Sheets("Service").Range("A9") = Sheets("Service").Range("A9") + 1
                            
                            Call READDRESS_FORMULA(j + 1, True)
                            Print #1, "   " + sheetF.Cells(i, 3).Text + "  " + VBA.Trim(sheetF.Cells(i, 4))
                            GoTo nnn1
                        End If
                    Else
                        tempStr = VBA.Trim(getFullCode(j))
                        If tempStr = IIf(VBA.Len(VBA.Trim(sheetF.Cells(i - 1, 3))) > 4, VBA.Left(VBA.Trim(sheetF.Cells(i - 1, 3)) + "     ", 10), VBA.Trim(sheetF.Cells(i - 1, 3)) + "000") + VBA.Trim(VBA.Right("00" + VBA.Trim(sheetF.Cells(i - 1, 1).Text), 3)) Then 'Sheets(pageName).Cells(j, fCol) = VBA.Trim(sheetF.Cells(i - 1, 2)) And Sheets(pageName).Cells(j, 6) = sheetF.Cells(i - 1, 1) Then
                            'снять защиту
                            Sheets(pageName).Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
                            Sheets(pageName).Rows(j + 1).Insert
                            Sheets(pageName).Cells(j + 1, 1) = Sheets(Sheets("service").Range("B19").Text).Range("A1") + 1
                            Sheets(pageName).Cells(j + 1, 2) = Sheets(pageName).Cells(j, 2)
                            Sheets(pageName).Cells(j + 1, 2).Select
                            
                            Sheets(pageName).Cells(j + 1, fCol) = sheetF.Cells(i, 2)
                            Sheets(pageName).Cells(j + 1, nameCol) = VBA.Trim(sheetF.Cells(i, 4))
'                            For k = 0 To Sheets("Service").Range("E4") - 2
'                                'temp = temp + IIf(sep <> "" And i <> 0, sep, "") + lSheetsReport.Cells(target, pnAddress_Col - lSheetsService.Range(lSheetsService.Range("E1")) + i).Text
'                                Sheets(pageName).Cells(j + 1, codeCol + k) = VBA.Mid(Sheets("Service").Range("B21"))
'                            Next
                            Call setCode(j + 1, VBA.Left(sheetF.Cells(i, 3) + "     ", 10) + VBA.Right("000" + VBA.Trim(sheetF.Cells(i, 1).Text), 3))
                            'Sheets(pageName).Cells(j + 1, codeCol) = sheetF.Cells(i, 3)
                            
                            Sheets(pageName).Rows(j + 1).AutoFit
                            sheetF.Rows(i).Interior.ColorIndex = 5
                            strCount = strCount - 1
                            Sheets(pageName).Cells(j + 1, 3).Interior.ColorIndex = 5
                            Sheets("Service").Range("A9") = Sheets("Service").Range("A9") + 1
                            
                            Call READDRESS_FORMULA(j + 1, True)
                            Print #1, "   " + sheetF.Cells(i, 3).Text + "  " + VBA.Trim(sheetF.Cells(i, 4))
                            GoTo nnn1
                        End If
                    End If
                Next
nnn1:
            End If
        Next
        
        Application.StatusBar = "Добавление строк: строка " + VBA.str(i) + " из " + VBA.str(strCount)
        Print #1, "Список необработанных строк бланка финтеха:"
        For i = 2 To strCount + 1
            If sheetF.Rows(i).Interior.ColorIndex = xlColorIndexNone Then
                Print #1, "   " + sheetF.Cells(i, 4).Text + "  " + VBA.Trim(sheetF.Cells(i, 4))
            End If
        Next
        
        If MsgBox("Добавленные и обновленные строки бланка помечены соответствующим цветом. Убрать пометку?", vbQuestion + vbYesNo, "Внимание !") = vbYes Then
            For j = Sheets("Service").Range("C5") To Sheets("Service").Range("A9")
                Sheets(pageName).Cells(j, 3).Interior.ColorIndex = xlColorIndexNone
            Next
        End If
    
    End If
    Application.ScreenUpdating = True
End Sub

Function LoadData(fileName As String, Optional fieldsList As String = "*", Optional wsd As Worksheet = Nothing, Optional addCond As String = "") As Integer
Dim startRange As Range, qt As QueryTable, odbcDriver As String, odbcstr As String, n As Integer
Dim columnsCount As Integer, rowsCount As Integer
    LoadData = 0
    Application.StatusBar = "Загрузка рабочих данных..."
    If wsd Is Nothing Then Set wsd = Sheets("DBF_EXCHANGE")
    wsd.Activate
    Set startRange = wsd.Cells(1, 1)
    odbcDriver = GetODBCDriver()
    dbPath = IIf(dbPath = "", ThisWorkbook.path + "\", dbPath)
    odbcstr = "ODBC;" + _
        "Driver=" + odbcDriver + ";" + _
        "UID=admin;SourceType=DBF;" + _
        "DefaultDir=" + dbPath + "\;" + _
        "DBQ=" + dbPath + "\;" + _
        "SourceDB=" + dbPath + "\;"
    Set qt = wsd.QueryTables.Add(odbcstr, _
        startRange, "SELECT " + fieldsList + " FROM " + fileName + " " + addCond)
    qt.BackgroundQuery = False
    qt.FieldNames = True
    On Error GoTo Err1
    qt.Refresh
    On Error GoTo 0
    columnsCount = qt.ResultRange.Columns.count
    rowsCount = qt.ResultRange.Rows.count - 1
    LoadData = rowsCount
    'If rowsCount <= 2 Then
    '    rowsCount = rowsCount + 1
    'End If
    Application.StatusBar = ""
Exit Function
Err1:
    Call MsgBox("Ошибка загрузки данных. Проверьте наличие файлов vk050.DBF, vk051.DBF, SS02050.DBF, SS02051.DBF в каталоге C:\FINTEH ", vbCritical, "Ошибка")
    LoadData = 0
    'Call MsgBox("Ошибка загрузки данных!", vbCritical + vbOKOnly, "Ошибка")
End Function

Function GetODBCDriver() As String
    Dim lcDriver As String, lcKey As String
    Dim hKey As Long, lnSize As Long, e As Long, i As Long
    Dim llFox As Boolean, llVisual As Boolean
    e = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI", 0, KEY_QUERY_VALUE, hKey)
    i = 0
    llFox = False
    llVisual = False
    Do
        lcKey = Space(250)
        lnSize = Len(lcKey)
        e = RegEnumKey(hKey, i, lcKey, lnSize)
        If Trim(lcKey) <> "" Then
            lcDriver = Mid(Trim(lcKey), 1, Len(Trim(lcKey)) - 1)
            llFox = llFox Or lcDriver Like "Microsoft FoxPro Driver*"
            llVisual = llVisual Or lcDriver Like "Microsoft Visual FoxPro Driver*"
        End If
        i = i + 1
    Loop While e = ERROR_SUCCESS
    RegCloseKey hKey
    GetODBCDriver = IIf(llVisual, "Microsoft Visual FoxPro Driver", IIf(llFox, "Microsoft FoxPro Driver (*.dbf)", "Microsoft Visual FoxPro Driver"))
End Function

Public Sub readLetterData()
Dim pageRazd, columnCount, rowCount, i, lnColumn1, lnRow1, page As Integer, j As Integer
Dim pName As String

With Sheets("Service").Range("KRIT_RAZDEL")
     lnColumn1 = .column
     lnRow1 = .row
End With
Call init_data

ReDim letArr(Sheets("Service").Range("B23"))
For i = 1 To Sheets("Service").Range("B23")
    ' установим страницу
    ' зададим критерий
    Sheets("Service").Cells(lnRow1 + 1, lnColumn1) = i
    If Sheets("Service").Range("B23") = 1 Then
        page = Sheets("Service").Range("B20")
        pName = Sheets("Service").Range("B19")
    Else
        page = Sheets("Service").Cells(lnRow1 + 2, lnColumn1).Text
        pName = Sheets("Service").Cells(lnRow1 + 3, lnColumn1).Text
    End If
    Sheets(pName).Activate

    With Sheets("Service")
        columnCount = .Range("A10")
        rowCount = .Range("A9") - .Range("C5") + 1
        
        'читаем раздел листа
        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = page
        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN + 1) = ""
        .Cells(KRIT_RAZDEL_ROW + 5, KRIT_RAZDEL_COLUMN).CALCULATE
        pageRazd = .Cells(KRIT_RAZDEL_ROW + 5, KRIT_RAZDEL_COLUMN)
        .Cells(KRIT_RAZDEL_ROW + 1, KRIT_RAZDEL_COLUMN) = ""
        
        ReDim letArr(page).data(columnCount)
        ReDim letArr(page).Razdel(columnCount)
        .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 2) = page
        .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN + 1) = ""
        For j = 1 To columnCount
            .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = j
            .Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN).CALCULATE
            .Cells(KRIT_GRAF_ROW + 5, KRIT_GRAF_COLUMN).CALCULATE
            letArr(page).data(j) = .Cells(KRIT_GRAF_ROW + 3, KRIT_GRAF_COLUMN)
            letArr(page).Razdel(j) = VBA.Trim(pageRazd) + VBA.Trim(.Cells(KRIT_GRAF_ROW + 5, KRIT_GRAF_COLUMN))
        Next
        .Cells(KRIT_GRAF_ROW + 1, KRIT_GRAF_COLUMN) = ""
        
        letArr(page).flag = True
    End With
Next
End Sub

