Excel VBA: заполнение ячеек со значениями массива очень медленное

Question

Я пытаюсь выполнить форматирование данных для экспорта QuickBooks, и один шаг очень медленный. У меня есть лист под названием «Выход», в котором есть каждая запись, выложенная в нужном формате, но я хочу, чтобы полностью заполненные были использованы на другом листе под названием «Карта».

Все до этого момента выполняется с помощью формул, и эта часть работает нормально. Я написал небольшой сценарий, чтобы перебрать все записи и вывести соответствующую информацию из «Вывод» в пять разных массивов. Затем он возвращается назад по этим массивам и заполняет ячейки в соответствующих столбцах в «Карта».

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

Sub Prettify() 

    Dim numbers() 
    Dim catagories() 
    Dim classes() 
    Dim subclasses() 
    Dim values() 

    Dim count As Integer 

    count = 2 

    ' The upper bounds of the loop is a calculation of the number of entries we will access 

    For i = 2 To (Sheets("Data").Cells(7, 8).Value * Sheets("Data").Cells(4, 3).Value + 2) 


     If (Sheets("Output").Cells(i, 1).Value = "") Then 

      ' Do Nothing 

     Else 

      ReDim Preserve numbers(count) 
      ReDim Preserve catagories(count) 
      ReDim Preserve classes(count) 
      ReDim Preserve subclasses(count) 
      ReDim Preserve values(count) 

      count = count + 1 

      numbers(count - 2) = Val((Sheets("Output").Cells(i, 1).Value)) 
      catagories(count - 2) = Sheets("Output").Cells(i, 2).Value 

      If (Sheets("Output").Cells(i, 3).Value = 0) Then 

       classes(count - 2) = Sheets("Output").Cells(i, 4).Value 
       subclasses(count - 2) = "" 

      Else 

       classes(count - 2) = Sheets("Output").Cells(i, 3).Value 
       subclasses(count - 2) = Sheets("Output").Cells(i, 4).Value 

      End If 

      values(count - 2) = Sheets("Output").Cells(i, 5).Value 

     End If 

    Next 

    MsgBox (numbers(0)) 
    MsgBox (catagories(0)) 

    Sheets("Map").Activate 

    ' This next part is slow 

    For j = 2 To count 

     Sheets("Map").Cells(j, 1).Value = numbers(j - 2) 
     Sheets("Map").Cells(j, 2).Value = catagories(j - 2) 
     Sheets("Map").Cells(j, 3).Value = classes(j - 2) 
     Sheets("Map").Cells(j, 4).Value = subclasses(j - 2) 
     Sheets("Map").Cells(j, 5).Value = values(j - 2) 

    Next 

End Sub 

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

Answer 1

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

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

Похоже, что вы получаете данные из книги так же.

Это код, который должен сортировать его, его просмотр будет действительно простым, но он действительно работает.

Dim v_Data() as variant 
Dim range_to_Load as range 
Dim y as long, x as long 
'set a range or better still use a list object 
set range_to_Load = thisworkbook.sheets("Data").Range("A1:F100") 
'Load the range into a variant array. 
with range_to_Load 
    redim v_data(1 to .rows.count, 1 to .columns.count) 
    v_data = .value 
end with 
' v_data now holds all in the range but as a multidimentional array 
' to access it its going to be like a grid so 
v_data(row in the range, column in the range) 
'Loop through the array, I'm going to covert everything to a string then 
'dump it in the Map sheet you have 
' you should avoid x,y as variables however this is a good use as they are coordinate values. 
'lbound and ubound will loop y though everything by row as it is the first dimension in the array. 
For y = lbound(v_data) to ubound(v_data) 
    ' next we are going to do the same but for the second dimention 
    For x = lbound(v_data,2) to ubound(v_data,2) 
     vdata(y,x) = cstr(v_data(y,x)) 
    Next x 
Next y 
'We have done something with the array and now want to put it somewhere, we could just drop it where we got it from to do this we would say 
range_to_Load.value = v_data 
' to put it else where 
thisworkbook.sheets("Map").range("A1").resize(ubound(v_data), ubound(v_data,2)).value = v_data 

Это должно решить вашу проблему, вы можете сделать так много с этим. Читайте на многомерных массивах, Чип Пирсон, как обычно, имеет много возможностей сказать и поможет.

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

Answer 2

Попробуйте использовать это в начале вашего кода

Application.ScreenUpdating = False 
Application.EnableEvents = False 
Application.Calculation = xlCalculationManual 
ActiveSheet.DisplayPageBreaks = False 

И в конце концов, добавить

Application.ScreenUpdating = True 
Application.EnableEvents = True 
Application.Calculation = xlCalculationAutomatic 
ActiveSheet.DisplayPageBreaks = True 

Теперь вы будете иметь проблемы, если ваш код ломается, потому что я повернулся расчет в ручную. Поэтому вы должны добавить обработчик ошибок. Если это слишком сложно, удалить все Бар экран обновляя один

Таким образом, в верхней части, а также добавить

On Error GoTo ErrHandler 

И в конце добавить:

Exit Sub 
ErrHandler: 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    ActiveSheet.DisplayPageBreaks = True 

End Sub 

Я надеюсь, что это помогает ,

Answer 3

Kamilla Whatling предлагает использовать многомерные массивы, объекты Range и различную популяцию клеток, чтобы ускорить процесс. Они работали и ниже - это окончательный код проекта, который работает быстро и одновременно удаляет нежелательные записи.

Sub Prettify() 

Dim values() As Variant 
Dim usableRange As Range 
Dim rangeSelection As String 
Dim entryNumber As Long 
Dim count As Long 

count = 0 

entryNumber = Sheets("Data").Cells(4, 3).Value * Sheets("Data").Cells(7, 8).Value 

rangeSelection = "A2:E" & (entryNumber + 1) 

Set usableRange = Sheets("Output").Range(rangeSelection) 

For i = 1 To entryNumber 

    If Sheets("Output").Cells(i, 1) = "" Then 

    Else 

     count = count + 1 

    End If 

Next 

ReDim values(count, 5) 
count = 0 

For i = 1 To entryNumber 

    If usableRange.Cells(i, 1) = "" Then 

    Else 

     values(count, 0) = usableRange.Cells(i, 1).Value 
     values(count, 1) = usableRange.Cells(i, 2).Value 

     If usableRange.Cells(i, 3).Value = 0 Then 

      values(count, 2) = usableRange.Cells(i, 4).Value 
      values(count, 3) = "" 

     Else 

      values(count, 2) = usableRange.Cells(i, 3).Value 
      values(count, 3) = usableRange.Cells(i, 4).Value 

     End If 

     values(count, 4) = usableRange.Cells(i, 5).Value 

     count = count + 1 

    End If 

Next 

Sheets("Map").Range("A2").Resize(UBound(values), 5).Value = values 

End Sub 

Благодарим за помощь всем людям!