Страницы: 1
RSS
Копирование диапазона из одной книги в другую с помощью ADO
 
Добрый день, товарищи. Есть книга, на листы которой копируются ячейки из других книг. Объем информации очень большой, например, 47 столбцов и 50 000 строк, выполняется эта операция очень долго ну и пока оно в очередной раз собиралось, решил погуглить, как подобное можно ускорить. Нашел информацию, что можно подключаться к книге как к базе данных, используя ADO и копировать из неё необходимые данные в другую книгу. Каков вопрос, действительно ли использование ADO ускорит процесс или же игра не стоит свеч? Так же, если кто-либо сталкивался с ADO в VBA, прошу скинуть ресурс, на котором можно встретить примеры использования или же адекватное объяснение синтаксиса, желательно русскоязычный, но можно и англоязычный, просто на русском быстрее разберусь. Заранее спасибо.
 
Halfeffectsys, добрый.
Просто берите в массив нужные данные и вставляйте в нужное место.
 
Ресурс: https://vk.com/excelsql
Excel + SQL = Activetables
 
Jungl, Скорость станет выше?
PowerBoy, Не совсем то, что мне нужно, так как файл, макрос для которого я пишу, будет использоваться несколькими пользователями, будет просто невозможно установить для всех надстройку.
 
(4) так-то там надстройку можно "встроить" в сам файл.
Excel + SQL = Activetables
 
Halfeffectsys,  зависит от того, что и как вы собираетесь вставлять. Отсеивание неугодных записей присутствует или чисто метод "копировать и вставить"?
Вы бы файл пример приложили, а там дело быстрее пойдет.
Если не более 65к строк, то я бы занес данные в массив и из него потом application.transpose сделал на лист.
 
PowerBoy,Ок, тогда посмотрю.
Jungl,  Просто копировать - вставить, пример нет смысла прилагать.просто два файла, из одного вставить в другой.
 
Halfeffectsys, проверьте, может быть вам будет этого достаточно, чем городить огород из ADO объектов и запросов.
Подгоните под свои файлы.
Код
T = Timer
Set TW = ThisWorkbook
Set OW = Workbooks.Open("D:\Book2.xlsm")
With TW.Sheets("1")
    arr = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 47))
End With
With OW
    .Sheets("2").Cells(2, 1).Resize(UBound(arr), 47) = arr
    .Activate
    '.Save
    '.Close
End With
MsgBox Format(Timer - T, "0.000") & " seconds"
 
Jungl,Попробую, спасибо.
 
Jungl, Попробовал, посчитал через t = Time, массивом вышло даже дольше, к сожалению, придется рыть интернет и городить огород...
 
А сколько по времени занимает Ваше копирование диапазона 50000х47?  Это вместе с форматами, условным форматирование и формулами?
Неизлечимых болезней нет, есть неизлечимые люди.
 
Halfeffectsys, может быть, потому что делаются еще какие-то действия? Может быть книги много весят?

Попробуйте ADO:
Код
Set CON = CreateObject("ADODB.Connection"): CON.CursorLocation = 3
CON.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "D:\Book1.xlsm" & ";Extended Properties=""Excel 12.0;HDR=YES"";"
Set RS = CON.Execute("Select * FROM [1$]")
If Not RS.EOF Then
    arr = RS.GetRows
    With ThisWorkbook.Sheets("2")
        .Cells(2, 1).Resize(RS.RecordCount, UBound(arr) + 1) = Application.Transpose(arr)
    End With
End If
Где [1$] это имя листа, откуда будем тянуть данные.
Страницы: 1
Читают тему
Наверх