MyTetra Share
Делитесь знаниями!
Загрузка данных из закрытой книги Excel в двумерный массив
16.03.2019
23:43
Текстовые метки: Open,Workbooks.Open
Раздел: !Закладки - VBA - GetOpen

Загрузка данных из закрытой книги Excel в двумерный массив

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 просмотров
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования