Public m_ul(500, 300) As String

Sub Start()
    p$ = Workbooks(Book1.xls").Path + "\Data\"
    Workbooks.Open p$ + "Book2.xls", ReadOnly
    Application.Run "Book2.xls!Module.Start(m_ul)"
End Sub

Public m_ul(500, 300) As String

Sub Start(m_ul() As String)
Dim Msg, Style, Title As String
    Msg = "Çàâàíòàæèòè äàí³ ïî Î.Ð.?"
    Style = vbYesNo + vbInformation + vbDefaultButton2
    Title = "Çàâàíòàæåííÿ áàçè Î.Ð."
    Response = MsgBox(Msg, Style, Title)
    Check = False
    If Response = vbYes Then
        On Error GoTo Label1
        p$ = Workbooks("Book1.xls").Path + "\Data\"
        Workbooks.Open p$ + "BASA.xls", ReadOnly
        Load UserForm1
        UserForm1.Show
        Workbooks("BASA.xls").Close SaveChanges:=False
        Workbooks("Book2.xls").Close SaveChanges:=False
        Workbooks("Book1.xls").Activate
        Check = True
    End If
Exit Sub
Label1:
    Msg = "Ôàéë äëÿ çàâàíòàæåííÿ íå â³äêðèâàºòüñÿ!"
    Msg1 = "Ïðîãðàììà çàâàíòàæåííÿ Î.Ð. áóäå çàêðèòà! "
    Style = vbOKOnly + vbCritical + vbDefaultButton2
    Title = "Ïîìèëêà"
    Response = MsgBox(Msg + Chr(13) + Msg1, Style, Title)
End Sub

'UserForm1

Private Sub UserForm_Activate()
Dim col_strok, col_kv, j As Integer
Dim n As Integer
Dim s, t111 As String
Dim ch As Boolean

Workbooks("BASA.xls").Activate
Erase m_ul
col_strok = Cells(Rows.Count, 1).End(xlUp).Row ''ïîñëåäíÿÿ çàïîëíåíàÿ ñòðîêà
col_street = 1
'Çàãðóçêà óëèö

For n = 1 To col_strok
    pos = InStr(1, R_Adr(n), " êâ.")
    s = Mid(R_Adr(n), 5, pos - 4)
    ch_street = False
    For i = 1 To col_street
        If s = m_ul(i, 0) Then
            ch_street = True
            Exit For
        End If
    Next i
    If ch_street = False Then
        m_ul(col_street, 0) = s
        m_ul(0, 0) = col_street
        col_street = col_street + 1
    End If
    DoEvents
    Call toolbar_1(CLng(n), CLng(col_strok))
Next n
'Çàãðóçêà êâàðòèð
Frame2.Visible = True
For n = 1 To col_strok
    pos = InStr(1, R_Adr(n), " êâ.")
    s = Mid(R_Adr(n), 5, pos - 4)
    'Range(Cells(n, 1), Cells(n, 1)).Show
    For i = 1 To col_street
        col_kv = 1
        Do While s = m_ul(i, 0)
        If m_ul(i, col_kv + 1) = "" Then
            m_ul(i, col_kv + 1) = Str(n)
            m_ul(i, 1) = col_kv
            Exit For
        Else
            col_kv = col_kv + 1
        End If
        Loop
    Next i
    DoEvents
    Call toolbar_2(CLng(n), CLng(col_strok))
Next n

Frame3.Visible = True
Call BubbleSort

Msg = "Çàâàíòàæåííÿ Î.Ð. çàâåðøåíî"
Style = vbOKOnly + vbInformation + vbDefaultButton2
Title = "Çàâàíòàæåííÿ"
Response = MsgBox(Msg, Style, Title)

Unload UserForm1
End Sub