VBA Медленные пишущие массивы, чтобы преуспеть в рабочей книге

Question

Просто интересно, может ли кто-нибудь предложить какие-либо предложения, которые могли бы улучшить скорость, которую мой код записывает в рабочую книгу.

Я пишу около 1,9 миллиона строк данных на несколько листов в книге, по одному листу за раз. Пока код завершается, требуется около 18 часов, чтобы написать книгу Excel, которая кажется смехотворно чрезмерной. Вот настройка. Я открыть книгу как таковые:

Dim ExcelAp As Excel.Application 
Dim ouputWorkbook As Excel.Workbook 

Set ExcelAp = New Excel.Application 
Set outputWorkbook = ExcelAp.Workbooks.Open("S:\Some Directory\Template.xlsx") 

Тогда у меня есть строки рабочей книги в массивах, загруженных в цикл сбора и ввода через диапазоны в рабочей книге для копирования массивов:

For lonSheetOneCounter = 2 to 999999 
    outputWorkbook.Worksheets(1).Range(_ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _ 
     outputCollection.item(lonSheetOneCounter - 1) 
Next lonSheetOneCounter 

метод копирования одинаковый для других листов. Я сделал книгу и экземпляр excel невидимым, я переключил расчет на руководство для этой книги, и я также отключил обновление экрана, но все равно требуется около 18 часов, чтобы завершить копирование в новую книгу.

Я попытался сделать 2-мерный массив для листа entier, но независимо от метода, который я использую для этого, я получаю ошибку «из памяти» в тот момент, когда я пытаюсь скопировать этот массив в рабочую книгу.

Я не уверен, есть ли что-нибудь еще, что я могу сделать, чтобы получить ошибку и сократить время на копирование, но если у кого-то есть предложение, я все уши. Для чего это стоит, этот макрос размещается в другой книге excel, работающей в отдельном экземпляре excel из рабочей книги, к которой я пытаюсь скопировать.

Редактировать: Незначительное дополнение здесь. Что-то, что я заметил, что я хотел обратить внимание на это, также заставляет меня думать, что возможно ускорить процесс. Я заметил, что макрос замедляется постепенно. Первое число строк X очень быстро записывается, следующие строки, похоже, все больше замедляются по мере записи каждой строки ...

Я собираюсь попробовать эксперимент, в котором я установил свой шаблон для автоматической загрузки таблица с 1 миллионом используемых строк ... вроде подсказываются предложением внизу. Мне интересно, стоит ли excel выделять память для всех дополнительных строк. Возможно, если я начну с шаблона рабочей книги, у которого уже установлено такое количество строк, мне может быть проще.

Редактировать: Мне было указано, что я не знаю, откуда берутся данные, которые я читаю. Эти данные считываются с использованием примитивов VBA из нескольких текстовых файлов. Один из них связан с каналом, две другие запятые, а не то, что схема файлов имеет большое значение.

Что касается заполнения массива, вот фрагмент того, как это происходит. Это выглядит беспорядок, но просто нет другого способа получить данные для соответствия формату трех файлов, которые я сравниваю. Во всяком случае, теперь, когда я помещаю все в большие большие массивы, я собираю эти массивы. Ссылки на arrViLine и arrNonIraLine и arrIraLine просто массивы, что строки файла разобранные в от их исходной трубы и разделенных запятыми форматов:

If arrViLine(2) = arrIraLine(1) Or arrViLine(2) = arrNonIraLine(1) Then 
     If arrViLine(2) = arrIraLine(1) Then 
      boolVi = True 
      boolIra = True 
      boolNonIra = False 
      If lonMatchCounter <= 999999 Then 
       matchOneArray(lonMatchCounter, 1) = arrViLine(1) 
       matchOneArray(lonMatchCounter, 2) = arrViLine(2) 
       matchOneArray(lonMatchCounter, 3) = arrIraLine(2) 
       matchOneArray(lonMatchCounter, 4) = arrIraLine(3) 
       matchOneArray(lonMatchCounter, 5) = arrViLine(3) 
       matchOneArray(lonMatchCounter, 6) = arrViLine(4) 
       matchOneArray(lonMatchCounter, 7) = arrIraLine(4) 
       matchOneArray(lonMatchCounter, 8) = arrViLine(6) 
       matchOneArray(lonMatchCounter, 9) = arrViLine(5) 
       matchOneArray(lonMatchCounter, 10) = arrViLine(7) 
       matchOneArray(lonMatchCounter, 11) = arrViLine(8) 
       matchOneArray(lonMatchCounter, 12) = arrViLine(9) 
       matchOneArray(lonMatchCounter, 13) = arrViLine(10) 
       matchOneArray(lonMatchCounter, 14) = arrViLine(11) 
       matchOneArray(lonMatchCounter, 15) = arrViLine(12) 
       matchOneArray(lonMatchCounter, 16) = arrIraLine(5) 
       matchOneArray(lonMatchCounter, 17) = arrIraLine(6) 
       matchOneArray(lonMatchCounter, 18) = arrViLine(13) 
       matchOneArray(lonMatchCounter, 19) = arrViLine(14) 
       matchOneArray(lonMatchCounter, 20) = "IRA" 
       matchOneArray(lonMatchCounter, 21) = arrViLine(15) 
       lonMatchCounter = lonMatchCounter + 1 
      Else 
       lonMatchTwoCounter = lonMatchCounter - 999999 
       matchTwoArray(lonMatchTwoCounter, 1) = arrViLine(1) 
       matchTwoArray(lonMatchTwoCounter, 2) = arrViLine(2) 
       matchTwoArray(lonMatchTwoCounter, 3) = arrIraLine(2) 
       matchTwoArray(lonMatchTwoCounter, 4) = arrIraLine(3) 
       matchTwoArray(lonMatchTwoCounter, 5) = arrViLine(3) 
       matchTwoArray(lonMatchTwoCounter, 6) = arrViLine(4) 
       matchTwoArray(lonMatchTwoCounter, 7) = arrIraLine(4) 
       matchTwoArray(lonMatchTwoCounter, 8) = arrViLine(6) 
       matchTwoArray(lonMatchTwoCounter, 9) = arrViLine(5) 
       matchTwoArray(lonMatchTwoCounter, 10) = arrViLine(7) 
       matchTwoArray(lonMatchTwoCounter, 11) = arrViLine(8) 
       matchTwoArray(lonMatchTwoCounter, 12) = arrViLine(9) 
       matchTwoArray(lonMatchTwoCounter, 13) = arrViLine(10) 
       matchTwoArray(lonMatchTwoCounter, 14) = arrViLine(11) 
       matchTwoArray(lonMatchTwoCounter, 15) = arrViLine(12) 
       matchTwoArray(lonMatchTwoCounter, 16) = arrIraLine(5) 
       matchTwoArray(lonMatchTwoCounter, 17) = arrIraLine(6) 
       matchTwoArray(lonMatchTwoCounter, 18) = arrViLine(13) 
       matchTwoArray(lonMatchTwoCounter, 19) = arrViLine(14) 
       matchTwoArray(lonMatchTwoCounter, 20) = "IRA" 
       matchTwoArray(lonMatchTwoCounter, 21) = arrViLine(15) 
       lonMatchCounter = lonMatchCounter + 1 
      End If 
     Else 'arrViLine(2) must = arrNonIraLine(1) 
      boolVi = True 
      boolIra = False 
      boolNonIra = True 
      If lonMatchCounter <= 999999 Then 
       matchOneArray(lonMatchCounter, 1) = arrViLine(1) 
       matchOneArray(lonMatchCounter, 2) = arrViLine(2) 
       matchOneArray(lonMatchCounter, 3) = arrNonIraLine(2) 
       matchOneArray(lonMatchCounter, 4) = arrNonIraLine(3) 
       matchOneArray(lonMatchCounter, 5) = arrViLine(3) 
       matchOneArray(lonMatchCounter, 6) = arrViLine(4) 
       matchOneArray(lonMatchCounter, 7) = arrNonIraLine(5) 
       matchOneArray(lonMatchCounter, 8) = arrViLine(6) 
       matchOneArray(lonMatchCounter, 9) = arrViLine(5) 
       matchOneArray(lonMatchCounter, 10) = arrViLine(7) 
       matchOneArray(lonMatchCounter, 11) = arrViLine(8) 
       matchOneArray(lonMatchCounter, 12) = arrViLine(9) 
       matchOneArray(lonMatchCounter, 13) = arrViLine(10) 
       matchOneArray(lonMatchCounter, 14) = arrViLine(11) 
       matchOneArray(lonMatchCounter, 15) = arrViLine(12) 
       matchOneArray(lonMatchCounter, 16) = arrNonIraLine(4) 
       matchOneArray(lonMatchCounter, 17) = arrNonIraLine(6) 
       matchOneArray(lonMatchCounter, 18) = arrViLine(13) 
       matchOneArray(lonMatchCounter, 19) = arrViLine(14) 
       matchOneArray(lonMatchCounter, 20) = "IRA" 
       matchOneArray(lonMatchCounter, 21) = arrViLine(15) 
       lonMatchCounter = lonMatchCounter + 1 
      Else 
       lonMatchTwoCounter = lonMatchCounter - 999999 
       matchTwoArray(lonMatchTwoCounter, 1) = arrViLine(1) 
       matchTwoArray(lonMatchTwoCounter, 2) = arrViLine(2) 
       matchTwoArray(lonMatchTwoCounter, 3) = arrNonIraLine(2) 
       matchTwoArray(lonMatchTwoCounter, 4) = arrNonIraLine(3) 
       matchTwoArray(lonMatchTwoCounter, 5) = arrViLine(3) 
       matchTwoArray(lonMatchTwoCounter, 6) = arrViLine(4) 
       matchTwoArray(lonMatchTwoCounter, 7) = arrNonIraLine(5) 
       matchTwoArray(lonMatchTwoCounter, 8) = arrViLine(6) 
       matchTwoArray(lonMatchTwoCounter, 9) = arrViLine(5) 
       matchTwoArray(lonMatchTwoCounter, 10) = arrViLine(7) 
       matchTwoArray(lonMatchTwoCounter, 11) = arrViLine(8) 
       matchTwoArray(lonMatchTwoCounter, 12) = arrViLine(9) 
       matchTwoArray(lonMatchTwoCounter, 13) = arrViLine(10) 
       matchTwoArray(lonMatchTwoCounter, 14) = arrViLine(11) 
       matchTwoArray(lonMatchTwoCounter, 15) = arrViLine(12) 
       matchTwoArray(lonMatchTwoCounter, 16) = arrNonIraLine(4) 
       matchTwoArray(lonMatchTwoCounter, 17) = arrNonIraLine(6) 
       matchTwoArray(lonMatchTwoCounter, 18) = arrViLine(13) 
       matchTwoArray(lonMatchTwoCounter, 19) = arrViLine(14) 
       matchTwoArray(lonMatchTwoCounter, 20) = "Non-IRA" 
       matchTwoArray(lonMatchTwoCounter, 21) = arrViLine(15) 
       lonMatchCounter = lonMatchCounter + 1 
      End If 
     End If 

Вы также можете игнорировать логические переменные, они там перемотать макрос относительно того, следует ли читать следующую строку определенного файла в следующем цикле.

РЕДАКТИРОВАНИЕ: Не то, чтобы он сильно влиял на то, как быстро я пишу данные, чтобы преуспеть, рассмотрите следующие строки как пример формата файлов, с которыми я работаю.

файл "Мастер":

Account Number|ID Number|Int Rate|Cum Int|Agreement|Type 
12345|111111|.005|.|"C"|"IRA" 
12346|111112|.005|.02345|"A"|"Non-IRA" 
12347|111113|.004|.02345|"B"|"Non-IRA" 

Match Файл Один:

ID Number|Int Rate|Cum Int|Type 
111111|.004|.|"IRA" 

Match Файл Два:

ID Number|Int Rate|Cum Int|Type 
111113|.004|.02345|"Non-IRA" 

Так что это всего лишь небольшой пример того, что я работать с. Текстовые файлы и CSV-файлы, которые перечислены в последовательном порядке по идентификационному номеру. В приведенном выше примере макрос будет соответствовать первой строке мастера, чтобы соответствовать первому файлу и записывать данные из всех полей из обоих файлов в массив, который будет выводиться в таблицу Excel. Затем макрос читает в следующей строке основного файла и сопоставляет файл один, но переносит строку из файла два в следующий цикл. Следующая строка мастера не будет соответствовать и будет записана на отдельном листе книги. Последняя строка мастера соответствует файлу соответствия 2 и записывается в тот же массив, что и первое совпадение.

Вот как работает рутина, тем не менее, реальная проблема, с которой я сталкиваюсь, - это скорость, с которой данные записываются в книгу Excel. В настоящее время я работаю над вырезанием данных в столбцы.

Answer 1

Вам не нужны коллекции: просто назначьте данные из листа в один вариант, а затем верните вариант на новый лист.

Чтобы свести к минимуму память и т. Д., Попробуйте использовать UsedRange на листе. Этот пример копирует колонки в то время: она занимает 35 секунд, чтобы скопировать 1 миллион строк на 21 столбцов с 1 листа на другой лист с помощью Excel 2010 32-разрядная

Sub getting() 
    Dim var As Variant 
    Dim j As Long 
    Dim dTime As Double 
    dTime = Now 
    For j = 1 To 21 
     var = Worksheets("Sheet3").UsedRange.Resize(, 1).Offset(0, j - 1).Value2 
     Worksheets("Sheet1").Range("a1").Resize(UBound(var), UBound(var, 2)).Offset(0, j - 1) = var 
    Next j 
    MsgBox CStr(Now - dTime) 
End Sub 

Answer 2

Я попытался проверить это будет полмиллиона строки, входящие в массив, но получившие ошибку из памяти. Вы не говорите, как вы заполняете свою коллекцию/массивы, но я полагаю, вы в состоянии это сделать. Я закончил с массивом 400k x 21 для демонстрационных целей.

Часть, которая занимает все время, заключается в том, что вы пишете на листе 21 ячейки за раз. Написание на листе - самое интенсивное время, которое вы можете сделать в Excel VBA, поэтому вам нужно максимально свести к минимуму эту операцию.

Для этого доказательства концепции я прочитал 400k x 21 фрагмент данных. Я пишу их с шагом в 100 тыс. Строк на разные листы. Для ваших целей вы должны сделать самый большой массив блоков, который может обрабатывать ваша память.

Sub WriteDataToFiles() 

    Dim vaData As Variant 
    Dim vaChunk() As Variant 
    Dim lStep As Long 
    Dim i As Long, j As Long, k As Long 
    Dim wb As Workbook, sh As Worksheet 
    Dim lStart As Long 

    lStart = Timer 

    'Process in 100,000 row increments 
    lStep = 10^5 

    'Fill a big array with a bunch of data 
    FillDataArray vaData 
    'Show how big the array is 
    Debug.Print UBound(vaData, 1) & " x " & UBound(vaData, 2) 

    'Create a new workbook to write to 
    Set wb = Workbooks.Add 

    'loop through the big array in 100k increments 
    For i = LBound(vaData, 1) To UBound(vaData, 1) Step lStep 

     'dimension a smaller range to hold a subset of the big array 
     ReDim vaChunk(1 To lStep, 1 To 21) 'clean out array 

     'fill the smaller array with data from big array 
     For j = LBound(vaChunk) To UBound(vaChunk) 
      For k = 1 To 21 
       vaChunk(j, k) = vaData(i + j - 1, k) 
      Next k 
     Next j 

     'Add a new sheet 
     Set sh = wb.Worksheets.Add 

     'Write the small array to the sheet 
     sh.Range("A1").Resize(UBound(vaChunk, 1), UBound(vaChunk, 2)).Value = vaChunk 

    Next i 

    'See how long it takes 
    Debug.Print Timer - lStart 

End Sub 

В окне Immediate:

400000 x 21 
8.68359375 

Около 9 секунд на моем печальном PC разделить 400K строк на четыре листа. Я поставил 100 кб на каждый лист, но я мог бы положить больше. Даже если вы работаете с шагом в 100 тыс. Строк, вы все равно можете разместить их на одном листе. Вместо «A1» в моем коде вам нужно записать свой кусок в следующую ячейку и отслеживать, где находится следующая ячейка. Затем, когда следующая ячейка составляет> 10^6 строк, вы создаете новый лист и начинаете все заново.

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

Answer 3

Ваше описание прогрессивно более медленных записей делает меня подозрительным, что вы сталкиваетесь с проблемой O (n^2) при использовании индекса коллекции.

Так попробуйте это: вместо индексации по коллекции, как вы сейчас:

For lonSheetOneCounter = 2 to 999999 
    outputWorkbook.Worksheets(1).Range(_ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _ 
     outputCollection.item(lonSheetOneCounter - 1) 
Next lonSheetOneCounter 

Попробуйте перечислить его вместо:

lonSheetOneCounter = 2 
For each item In outputCollection 
    outputWorkbook.Worksheets(1).Range(_ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 1).Address & ":" & _ 
     outputWorkbook.Worksheets(1).Cells(lonSheetOneCounter, 21).Address).Value = _ 
     item 
    lonSheetOneCounter = lonSheetOneCounter + 1 
Next 

И вы знаете, учитывая, что это VBA и вы повторное выполнение тела цикла в миллион раз, не помешало бы локализовать ваши ссылки и использовать прямые спецификации диапазона вместо строк:

lonSheetOneCounter = 2 
Dim ws As Worksheet 
Set ws = outputWorkbook.Worksheets(1) 
For each item In outputCollection 
    ws.Range(_ 
     ws.Cells(lonSheetOneCounter, 1), ws.Cells(lonSheetOneCounter, 21) 
      ).Value = item 
    lonSheetOneCounter = lonSheetOneCounter + 1 
Next 

Answer 4

Прежде всего, я думаю, что вы используете неправильный набор инструментов. VBA не может обрабатывать очень хорошо большие объемы данных, и записывать значение по значению очень медленно.

Лучший подходящий способ заключается в использовании набора записей, чтобы получить данные из файлов и сбросить его на шаблоне

Я предполагаю, что:

• Ваши файлы находятся в той же папке, что и книги который содержит код
• Существует файл называется master.csv (труба с разделителями) и файлы с именем ira.csv и non_ira.csv, как запятая разделителями

с что сказал, ваша программа может быть разделена на три этапа:

1. Создать Schema.ini файл
2. Получить данные из файлов с помощью ActiveX Data Objects библиотека
3. Дамп данных в Рабочем журнале

Шаг 1:schema.ini файл

Этот шаг необходим, потому что ваши файлы не имеют тот же дель imiter. этот шаг просто необходимо, чтобы создать файл с именем schema.ini в той же папке, что и ваши данные и вставьте код ниже:

[master.csv] 
DecimalSymbol=. 
Format=Delimited(|) 
ColNameHeader=True 

[ira.csv] 
DecimalSymbol=. 
Format=Delimited(,) 
ColNameHeader=True 

[non_ira.csv] 
DecimalSymbol=. 
Format=Delimited(,) 
ColNameHeader=True 

Этот файл может быть использован для определения различных atributes для ваших данных. Для получения дополнительной информации см это link

Шаг 2: Получить данные из файлов с помощью ActiveX Data Objects библиотека

Во-первых, вам нужно добавить ссылку на ActiveX Data Objects библиотеки. Для этого откройте редактор VBA, затем перейдите к Tools>References и проверьте Microsoft ActiveX Data Objects library. Этот шаг необходим для использования SQL-запросов в ваших данных.

Далее, вы должны написать код, чтобы настроить подключение к данным, например:

Private Function CreateConnection(folderPath As String) As ADODB.Connection 

    Dim conStr As String 

    conStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
      "Data Source=" & Replace(folderPath, "\", "\\") & ";" & _ 
      "Extended Properties=""text;HDR=Yes;IMEX=1;FMT=Delimited"";" 

    Set CreateConnection = New ADODB.Connection 
    CreateConnection.Open conStr 

End Function 

Тогда вы можете написать функцию для создания записей на основе пользовательского запроса SQL, например:

Private Function GetData(cnn As ADODB.Connection, file As String) As ADODB.Recordset 

    Dim strSql As String 

    Const adOpenStatic = 3 
    Const adLockOptimistic = 3 
    Const adCmdText = &H1 
    'You'll need to change this variable to match your needs 
    strSql = "SELECT master.[Account Number], " & _ 
        " master.[ID Number], " & _ 
        " file.[Int Rate], " & _ 
        " file.[Cum Int] " & _ 
       "FROM [master.csv] master INNER JOIN [" & file & ".csv] file ON master.[ID Number] = file.[ID Number]" 
    Set GetData = New Recordset 
    GetData.Open strSql, cnn, adOpenStatic, adLockOptimistic, adCmdText 

End Function 

Эта функция возвращает набор записей с данными, который является общим для master и file, используя ID Number в качестве ключа

Шаг 3: Дамп данных в Рабочем журнале

Чтобы сделать это, вы можете написать что-то вроде этого:

Public Sub LoadData() 
    Dim cnn As ADODB.Connection 
    Dim rsIRA As ADODB.Recordset, rsNonIRA As ADODB.Recordset 
    Dim wbk As Workbook 

    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 

    'In this example the files and this workbook are in the same folder 
    Set cnn = CreateConnection(ThisWorkbook.Path & "\") 

    Set rsIRA = GetData(cnn, "ira") 
    Set rsNonIRA = GetData(cnn, "non_ira") 

    Set wbk = Workbooks.Open("S:\Some Directory\Template.xlsx") 

    'Dumps the data from the recordset 
    wbk.Worksheets(1).Range("A2").CopyFromRecordset rsIRA 
    wbk.Worksheets(1).Range("A2").Offset(rsIRA.RecordCount, 0).CopyFromRecordset rsNonIRA 

    Application.ScreenUpdating = True 

    'Clean up 
    rsIRA.Close 
    rsNonIRA.Close 
    cnn.Close 
    Set rsIRA = Nothing 
    Set rsNonIRA = Nothing 
    Set cnn = Nothing 

End Sub 

я тестировал с образцом данных, которые вы предоставили, и это сработало. Вам нужно будет адаптировать код для ваших нужд Я думаю, что он будет работать быстрее, поскольку он касается только DB/Excel API, устраняя узкое место VBA