;
 
Sub ПоискКолонокОСВ()
 
    For Each r In Range("A1:D20")
        If Not IsNull(rgxExtract2(r.Value, "\Контрагенты|Субконто")) And Len(r.Value) <= Len("Контрагенты") Then
            res = r.Value
            resRow = r.row
            resColumn = r.column
            Exit For
        End If
    Next r
 
ДебетН = GetColumn3("\Сальдо на начало периода", "Дебет")
КредитН = GetColumn3("\Сальдо на начало периода", "Кредит")
ДебетО = GetColumn3("\Обороты за период|Оборот за период", "Дебет")
КредитО = GetColumn3("\Обороты за период|Оборот за период", "Кредит")
ДебетК = GetColumn3("\Сальдо на конец периода", "Дебет")
КредитК = GetColumn3("\Сальдо на конец периода", "Кредит")
End Sub
Function GetColumn3(pattern As String, ДК_Н As String) As Variant
    For Each r In Range("A1:X20")
        If Not IsNull(rgxExtract2(r.Value, pattern)) Then
'            r.Select
            Merge = r.MergeArea.Address
                If Len(Merge) > 8 Then
                    Column_1 = Split(Merge, "$")(1)
                    Column_2 = Split(Merge, "$")(3)
                Else
'                    MsgBox "Не удалось найти начальное сальдо! =("
                    Exit Function
                End If
            Exit For
        End If
    Next r
 
    resRow = 10
    For Each r In Range(Column_1 & resRow & ":" & Column_2 & "20")
        If Not IsNull(rgxExtract2(r.Value, "\Дебет")) Then
            ДебетН = Split(r.Address, "$")(1)
        End If
 
        If Not IsNull(rgxExtract2(r.Value, "\Кредит")) Then
            КредитН = Split(r.Address, "$")(1)
        End If
    Next r
 
 
    If ДК_Н = "Дебет" Then
        GetColumn3 = ДебетН
        Exit Function
    End If
 
    If ДК_Н = "Кредит" Then
        GetColumn3 = КредитН
        Exit Function
    End If
 
End Function

; Sub ПоискКолонокОСВ() For Each r In Range("A1:D20") If Not IsNull(rgxExtract2(r.Value, "\Контрагенты|Субконто")) And Len(r.Value) <= Len("Контрагенты") Then res = r.Value resRow = r.row resColumn = r.column Exit For End If Next r ДебетН = GetColumn3("\Сальдо на начало периода", "Дебет") КредитН = GetColumn3("\Сальдо на начало периода", "Кредит") ДебетО = GetColumn3("\Обороты за период|Оборот за период", "Дебет") КредитО = GetColumn3("\Обороты за период|Оборот за период", "Кредит") ДебетК = GetColumn3("\Сальдо на конец периода", "Дебет") КредитК = GetColumn3("\Сальдо на конец периода", "Кредит") End Sub Function GetColumn3(pattern As String, ДК_Н As String) As Variant For Each r In Range("A1:X20") If Not IsNull(rgxExtract2(r.Value, pattern)) Then ' r.Select Merge = r.MergeArea.Address If Len(Merge) > 8 Then Column_1 = Split(Merge, "$")(1) Column_2 = Split(Merge, "$")(3) Else ' MsgBox "Не удалось найти начальное сальдо! =(" Exit Function End If Exit For End If Next r resRow = 10 For Each r In Range(Column_1 & resRow & ":" & Column_2 & "20") If Not IsNull(rgxExtract2(r.Value, "\Дебет")) Then ДебетН = Split(r.Address, "$")(1) End If If Not IsNull(rgxExtract2(r.Value, "\Кредит")) Then КредитН = Split(r.Address, "$")(1) End If Next r If ДК_Н = "Дебет" Then GetColumn3 = ДебетН Exit Function End If If ДК_Н = "Кредит" Then GetColumn3 = КредитН Exit Function End If End Function