Attribute VB_Name = "forma672"
'
Option Explicit

Public Sub MakeMemo()
'Public Sub MakeMemo(s As String)
Dim Cbac As String, Kind_Cr As String, FullMemo As String, ws As Object, ThisCells As Object, _
    cCol(19) As Long, i As Long, Memo As String, i2 As Long, ci As String, debt As String, i1 As Long
    Application.DisplayAlerts = False
    
    'находим номера столбцов для столбцов: CSUBSH, KIND_KRED, D16,D17,D18,D21,D22,D23,D26,D27,D28,D31,D32,D33,D36,D37,D38
    For Each ThisCells In ActiveWorkbook.Names("data").RefersToRange.Cells
        If ThisCells.Value = "csubsh" Then
            cCol(1) = ThisCells.Column
        End If
        If ThisCells.Value = "kind_cred" Then
            cCol(2) = ThisCells.Column
        End If
        If ThisCells.Value = "d16" Then
            cCol(4) = ThisCells.Column
        End If
        If ThisCells.Value = "d17" Then
            cCol(5) = ThisCells.Column
        End If
        If ThisCells.Value = "d18" Then
            cCol(6) = ThisCells.Column
        End If
        If ThisCells.Value = "d21" Then
            cCol(7) = ThisCells.Column
        End If
        If ThisCells.Value = "d22" Then
            cCol(8) = ThisCells.Column
        End If
        If ThisCells.Value = "d23" Then
            cCol(9) = ThisCells.Column
        End If
        If ThisCells.Value = "d26" Then
            cCol(10) = ThisCells.Column
        End If
        If ThisCells.Value = "d27" Then
            cCol(11) = ThisCells.Column
        End If
        If ThisCells.Value = "d28" Then
            cCol(12) = ThisCells.Column
        End If
        If ThisCells.Value = "d31" Then
            cCol(13) = ThisCells.Column
        End If
        If ThisCells.Value = "d32" Then
            cCol(14) = ThisCells.Column
        End If
        If ThisCells.Value = "d33" Then
            cCol(15) = ThisCells.Column
        End If
        If ThisCells.Value = "d36" Then
            cCol(16) = ThisCells.Column
        End If
        If ThisCells.Value = "d37" Then
            cCol(17) = ThisCells.Column
        End If
        If ThisCells.Value = "d38" Then
            cCol(18) = ThisCells.Column
        End If
        If ThisCells.Value = "debt" Then
            cCol(19) = ThisCells.Column
        End If
     Next ThisCells
     'первый цикл - перебираем все листы кроме листа "Данные" и "Документ"
     For Each ws In Application.ActiveWorkbook.Worksheets
        If ws.Name <> "Данные" And ws.Name <> "Документ" Then
            Kind_Cr = ws.[C5]
            If Kind_Cr = "неопределен" Then
                Kind_Cr = ""
            End If
            Cbac = ws.[B7]
            If Cbac = "неопределен" Then
                Cbac = ""
            End If
            FullMemo = ""
            i1 = 1
                    'формируем само примечание
                    For i = 1 To ActiveWorkbook.Names("data").RefersToRange.Row
                        If "" & ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(1)) = Cbac _
                            And ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(2)) = Kind_Cr _
                            Then
                            Memo = ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(4))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(5))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(6))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(7))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(8))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(9))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(10))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(11))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(12))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(13))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(14))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(15))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(16))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(17))
                            Memo = Trim(Memo) + " " + ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(18))
                            If Trim(Memo) <> "" Then
                                ci = "" & i1
                                i1 = i1 + 1
                                FullMemo = FullMemo + ci + ")" + Trim(Memo) + Chr(10)
                                debt = ActiveWorkbook.Names("data").RefersToRange.Cells(i, cCol(19))
                                For i2 = 1 To ws.Rows.Count
                                    If Trim(ws.Cells(i2, 1)) = Trim(debt) Then
                                       ws.Cells(i2, 1) = ci + ")" + ws.Cells(i2, 1)
                                    End If
                                Next i2
                            End If
                        End If
                    Next i
            'прописание примечания
            For i = 1 To ws.Rows.Count
                If ws.Cells(i, 1) = "ВСЕГО ПО ВИДУ КРЕДИТА(БЮДЖЕТНОЙ ССУДЫ)" Then
                    ws.Cells(i + 9, 1) = FullMemo
                End If
            Next i
        End If
     Next ws
End Sub

