Загрузка данных из закрытой книги 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

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Возможно (через ADO)

Dim masss() As String, stancii() As String, id_stancii

Private Sub UserForm_Activate()
Dim asd As String, metro_name() As String

List1.Clear
ReDim masss(0)
ReDim metro_name(0)
ReDim stancii(0)
ReDim id_stancii(0)

For i = 1 To 200
asd = ExecuteExcel4Macro("'C:\Users\Pobejali\Documents\[Книга1.xls]" & "Лист1'!R" & i & "C2")
If asd <> "0" And asd <> "" Then
masss(UBound(masss)) = asd
ReDim Preserve masss(UBound(masss) + 1)
Call split_by_raf(asd, ",", metro_name)

stancii(UBound(stancii)) = metro_name(2)
ReDim Preserve stancii(UBound(stancii) + 1)

List1.AddItem metro_name(2)
End If
Next i

List1.ListIndex = 0
End Sub

Класс! отлично работает! спасибо!

И так же будет исползоваться GetObject или еще что - то?

Возможно. Надо только знать название листа, и точный адрес диапазона ячеек с данными.
А этому коду не требуется ни то, ни другое.
К тому же, открытие файла происходит моментально и незаметно для пользователя.

А извлекать данные из закрытой книги, не открывая ее, невозможно?

Ни хрена не работает!

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  ____   __   __              _____   _       _ 
| _ \ \ \ / / _ __ ___ | ____| | |__ (_)
| | | | \ V / | '_ ` _ \ | _| | '_ \ | |
| |_| | | | | | | | | | | |___ | |_) | | |
|____/ |_| |_| |_| |_| |_____| |_.__/ |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.