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
|
