Excel 2010 For Next Loop становится все медленнее - PullRequest
Новая
       10

Excel 2010 For Next Loop становится все медленнее

0 голосов
/ 03 марта 2019

Мой вопрос касается добавления имен именованных диапазонов к данным на листе (импортированных из текстового файла), одновременного удаления лишних строк.

Для этого он использует особенность данных, котораяимеет строки, начинающиеся с «а» время от времени.Имя метки дается этой строкой, которая является уникальной.К строкам между этими строками, начинающимися с «a», следует добавить именованные имена диапазонов.

Я использую приведенный ниже код, но выполнение этого кода для 1000 строк занимает 25 секунд, для следующих 1000 строк - 80-85 секунд и т. Д. Время обработки увеличивается в геометрической прогрессии, хотя оно должно быть равно (?).

Есть идеи, что я могу сделать, чтобы улучшить время обработки?У меня более 20 тыс. Строк на листе и несколько листов, и сейчас для одного листа может потребоваться до 24 часов ... 

Sub Test()

Dim rng As Range
Dim named_range_name As String
Dim named_range_location As String
Dim start_row As Integer
Dim end_row As Integer
Dim x As Long
Application.ScreenUpdating = False

  NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
  Cells(NumRows + 1, "A").Value = "abcd"
  Range("A1").Select


  For x = 1 To NumRows + 1
     If Left(ActiveCell.Value, 1) = "a" And ActiveCell.Row = 1 Then
        start_row = ActiveCell.Row + 1
        named_range_name = Cells(ActiveCell.Row, "A").Value
        Else
            If Left(ActiveCell.Value, 1) = "a" And ActiveCell.Row <> 1 Then
                end_row = ActiveCell.Row - 1
                named_range_location = "A" & start_row & ":J" & end_row
                Set rng = Range(named_range_location)
                ThisWorkbook.Names.Add Name:=named_range_name, RefersTo:=rng
                start_row = ActiveCell.Row + 1
                named_range_name = Cells(ActiveCell.Row, "A").Value
            End If
     End If


     If ActiveCell.Value = "bcd" Then ActiveCell.EntireRow.Delete

     If ActiveCell.Value = "efgh" Then ActiveCell.EntireRow.Delete

     ActiveCell.Offset(1, 0).Select

  Next



End Sub

Пример данных перед сценарием vba: 

a008020a018024

bcd

efgh

unu False      3      3     21      7      5.59/  5.09      5.50/  5.01

doi False      2      2     22     11      8.79/  7.99      8.65/  7.87

trei False      4      4     20      5     15.98/ 14.53     11.77/ 10.70

patru False     11      2     22      2     17.59/ 16.00     14.07/ 12.80

cinci False     23      1     23      1     18.28/ 16.62     15.53/ 14.13

saseFalse      0      0     24      1     19.17/ 17.44     18.87/ 17.17

Данные имеют несколько блоков со структурой выше.Каждый такой блок имеет уникальную метку, начинающуюся с «а», за которой следует группа цифр.Блок имеет переменное количество строк.Данные между 2 такими метками должны быть ... ну, помечены.

Таким образом, если у A1 есть метка, а у A12 следующая метка, макрос должен удалить лишние строки в этом диапазоне и пометить оставшиеся данные меткой из A1.Затем перейдите к блоку между A12 и A20 (например) и повторите операцию, пометив его меткой из A12.

Кажется, проблема не в имени диапазона добавления, а в самом цикле (или другие вещи, заполняющие цикл).Я решил запустить цикл несколько раз только для первых 1000 строк, не выходя из Excel (поэтому запустил один раз, затем снова запустил и так далее).Результаты следующие:

Первый запуск: 28 секунд;Второй запуск: 113 секунд;Третий прогон: 293 секунды;Четвертый прогон: 473 секунды

Я прокомментировал добавление именованных диапазонов и времени выполнения (тот же сценарий, многократный запуск цикла для первых 1000 строк без выхода из Excel).Результаты:

Первый запуск: 27 секунд;Второй запуск: 129 секунд;и т.д.

Помогите!

1 Ответ

0 голосов
/ 03 марта 2019

Из того, что я могу расшифровать из вашего кода.

1 - выберите А1 и конец (вниз) до последней ячейки + 1, затем сделайте эту ячейку = "abc"

2 - Вы наделитеНе знаете, как начать с A2, поэтому у вас есть if cell starts with a then rowstart=2

3-петли через каждую ячейку и найти либо «bcd» или «efgh» и удалить строки

4-StopЦикл, когда вы добираетесь до своей первоначальной "abc"

5-Name оставшийся диапазон ячеек со значением в A1

Самый быстрый способ, который я нашел, чтобы удалить значения строк встолбец строк использует функцию VBA replace () и заменяет значения пробелами, тогда вы можете использовать специальные ячейки для удаления пробелов.

Я заметил в вашем коде, что вы используете end(xldown), который показываетМне следует отметить, что в ваших данных нет пробелов для начала, поэтому замена этих конкретных ячеек на пробелы будет работать.

Для пары тысяч строк результат очень быстрый, хотя и не уверен в десятках тысяч строк.

Проверьте это. 

Sub Button1_Click()
    Dim sh As Worksheet, rng As Range
    Set sh = ActiveSheet

    With sh
        Set rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

        With rng
            .Replace what:="bcd", replacement:="", lookat:=xlPart, MatchCase:=False
            .Replace what:="efgh", replacement:="", lookat:=xlPart, MatchCase:=False
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        End With

        .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Name = .Range("A1").Value
    End With

End Sub
...