Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Очень долгое выполнение кода - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Очень долгое выполнение кода
Очень долгое выполнение кода
Markovich Дата: Воскресенье, 13.06.2021, 20:52 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Доброго времени суток, уважаемые форумчане! Написал небольшой код по вставке из буфера обмена данных в таблицу Word. Сама вставка из буфера выполняется быстро, но работа цикла форматирование строки по условию в ячейке для 2000 строк работает до бесконечности долго (через 15 минут снимаю задачу через диспетчер). Подскажите, пожалуйста, в чем у меня ошибка, есть ли способ ускорить выполнение кода (в частности цикла), ведь обработать 2000 строк не такая огромная задача для современного компа? а то вручную быстрее получается перебрать
[vba]
Код

Sub Import()
On Error Resume Next
Application.ScreenUpdating = False
Dim i As Long
    With ActiveDocument
    n = Val(InputBox("Сколько строк в таблице?"))
    If n = 0 Then Exit Sub
    k = n - 1 'корректировка количества строк
    r = n + 1 'корректировка количества строк
        With .Tables(3) 'обращаюсь к третьей таблице
        .Rows(2).Select 'выбираю позицию для добавления строк
        Selection.InsertRowsBelow k 'вставвка заданного количества строк
        .Rows(1).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble 'красявости
        .Rows(r).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble 'красявости
        rs = .Cell(2, 2).Range.Start 'начало дипазона для вставки
        re = .Cell(r, 6).Range.End 'конец дипазона для вставки
        ActiveDocument.Range(rs, re).Paste 'вставка из буфера в заданный диапазон
            For i = 2 To r
                If .Cell(i, 3).Range.Characters.Count = 3 Then 'определение строки для форматирования
                .Cell(i, 2).Range.Copy 'копирую в память содержимое ячейки
                .Rows(i).Range.Delete Unit:=wdCharacter, Count:=1 'очистка строки
                .Cell(i, 1).Merge MergeTo:=.Cell(i, 6) 'объединение ячеек
                .Rows(i).Range.Paste 'вставка ранее запомненного значения
                .Rows(i).Shading.BackgroundPatternColor = wdColorGray15 'красявости
                End If
            Next
        End With
    End With
Application.ScreenUpdating = True
End Sub
[/vba]


Сообщение отредактировал Markovich - Воскресенье, 13.06.2021, 20:57
 
Ответить
СообщениеДоброго времени суток, уважаемые форумчане! Написал небольшой код по вставке из буфера обмена данных в таблицу Word. Сама вставка из буфера выполняется быстро, но работа цикла форматирование строки по условию в ячейке для 2000 строк работает до бесконечности долго (через 15 минут снимаю задачу через диспетчер). Подскажите, пожалуйста, в чем у меня ошибка, есть ли способ ускорить выполнение кода (в частности цикла), ведь обработать 2000 строк не такая огромная задача для современного компа? а то вручную быстрее получается перебрать
[vba]
Код

Sub Import()
On Error Resume Next
Application.ScreenUpdating = False
Dim i As Long
    With ActiveDocument
    n = Val(InputBox("Сколько строк в таблице?"))
    If n = 0 Then Exit Sub
    k = n - 1 'корректировка количества строк
    r = n + 1 'корректировка количества строк
        With .Tables(3) 'обращаюсь к третьей таблице
        .Rows(2).Select 'выбираю позицию для добавления строк
        Selection.InsertRowsBelow k 'вставвка заданного количества строк
        .Rows(1).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble 'красявости
        .Rows(r).Borders(wdBorderBottom).LineStyle = wdLineStyleDouble 'красявости
        rs = .Cell(2, 2).Range.Start 'начало дипазона для вставки
        re = .Cell(r, 6).Range.End 'конец дипазона для вставки
        ActiveDocument.Range(rs, re).Paste 'вставка из буфера в заданный диапазон
            For i = 2 To r
                If .Cell(i, 3).Range.Characters.Count = 3 Then 'определение строки для форматирования
                .Cell(i, 2).Range.Copy 'копирую в память содержимое ячейки
                .Rows(i).Range.Delete Unit:=wdCharacter, Count:=1 'очистка строки
                .Cell(i, 1).Merge MergeTo:=.Cell(i, 6) 'объединение ячеек
                .Rows(i).Range.Paste 'вставка ранее запомненного значения
                .Rows(i).Shading.BackgroundPatternColor = wdColorGray15 'красявости
                End If
            Next
        End With
    End With
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Markovich
Дата добавления - 13.06.2021 в 20:52
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Word » Очень долгое выполнение кода
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!