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 или еще что - то?
Возможно. Надо только знать название листа, и точный адрес диапазона ячеек с данными.
А этому коду не требуется ни то, ни другое.
К тому же, открытие файла происходит моментально и незаметно для пользователя.
А извлекать данные из закрытой книги, не открывая ее, невозможно?
Ни хрена не работает!
Отправить комментарий