Sub ПримерИспользования()

    ' задаём полный путь к обрабатываемому файлу

    ПутьКФайлу$ = ThisWorkbook.Path & "\" & "Contract.XLS"

    Application.ScreenUpdating = False    '  отключаем обновление экрана

    arr = LoadArrayFromWorkbook(ПутьКФайлу$, "a2", 30)    ' загружаем данные

    ' выводим результаты в окно Immediate

    Debug.Print "Загружен массив размерами " & UBound(arr, 1) & _

                " строк на " & UBound(arr, 2) & " столбцов"

End Sub

Код функции LoadArrayFromWorkbook:

Function LoadArrayFromWorkbook(ByVal filename$, ByVal FirstCellAddress$, _

                               Optional ByVal ColumnsCount& = 0) As Variant

    ' Функция открывает в скрытом режиме файл filename$,

    ' загружает в двумерный массив информацию с первого листа файла

    ' (по высоте - начиная с ячейки FirstCellAddress$,

    '  и заканчивая последней заполненной ячейкой в этом столбце,

    '  по ширине - начиная с ячейки FirstCellAddress$, обрабатывается ColumnsCount& столбцов)

    ' Если переменная ColumnsCount& не задана - загружаются строки целиком

    ' После обработки файл filename$ закрывается без сохранения изменений

    ' Функция возвращает сформированный двумерный массив

    On Error Resume Next: Err.Clear

    Dim wb As Workbook, sh As Worksheet, ra As Range

    Set wb = GetObject(filename$)

    If wb Is Nothing Then Debug.Print "Не удалось загрузить файл " & filename$: Exit Function

    Set sh = wb.Worksheets(1)

    Set ra = sh.Range(sh.Range(FirstCellAddress$), _

                      sh.Range(FirstCellAddress$).EntireColumn.Cells(sh.Rows.Count).End(xlUp))

    If ra Is Nothing Then Debug.Print "Не удалось обработать таблицу из файла " & _

       filename$: Debug.Print "Первая ячейка: " & FirstCellAddress$: wb.Close False: Exit Function

    If ColumnsCount& = 0 Then ColumnsCount& = sh.Columns.Count - sh.Range(FirstCellAddress$).Column + 1

    Err.Clear: Set ra = ra.Resize(, ColumnsCount&)

    If Err Then Debug.Print "Не удалось расширить диапазон в файле " & _

       filename$: Debug.Print "Первая ячейка: " & FirstCellAddress$, _

                              "ширина: " & ColumnsCount&: wb.Close False: Exit Function

    LoadArrayFromWorkbook = ra.Value

    wb.Close False

End Function

• 18226 просмотров