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

Вход

Регистрация

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

 

= Мир MS Excel/Сокращение времени работы макроса при сравнении столбцов - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сокращение времени работы макроса при сравнении столбцов (Макросы/Sub)
Сокращение времени работы макроса при сравнении столбцов
is_1 Дата: Понедельник, 11.09.2017, 11:13 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте, уважаемые форумчане!
Необходима помощь в решении задачи.
Дано: два листа в книге. На листе 1 в столбце «A» код товара, в столбце «B» названия отделов, столбцы «C», «D», «E» содержат некоторые значения (с 1 по 3).
На листе 2 в столбце «A» код товара, в строке 1 названия отделов, строке 2 названия перечень значения с 1 по 3.
Необходимо: проставить в соответствующие столбцы листа 2 показатели значений из листа 1. Макрос написал, но он работает очень медленно, когда возможных кодов товара на листе 2 больше 1500, а строк на листе один более 50000. Время работы с таким макросом составляет более 2 часов. Есть ли возможность оптимизировать его работу? Спасибо!
К сообщению приложен файл: example.xls(42Kb)
 
Ответить
СообщениеЗдравствуйте, уважаемые форумчане!
Необходима помощь в решении задачи.
Дано: два листа в книге. На листе 1 в столбце «A» код товара, в столбце «B» названия отделов, столбцы «C», «D», «E» содержат некоторые значения (с 1 по 3).
На листе 2 в столбце «A» код товара, в строке 1 названия отделов, строке 2 названия перечень значения с 1 по 3.
Необходимо: проставить в соответствующие столбцы листа 2 показатели значений из листа 1. Макрос написал, но он работает очень медленно, когда возможных кодов товара на листе 2 больше 1500, а строк на листе один более 50000. Время работы с таким макросом составляет более 2 часов. Есть ли возможность оптимизировать его работу? Спасибо!

Автор - is_1
Дата добавления - 11.09.2017 в 11:13
Kuzmich Дата: Понедельник, 11.09.2017, 11:46 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 303
Репутация: 57 ±
Замечаний: 0% ±

Excel 2003
Макрос, запускать при активном листе "2"
[vba]
Код

Sub Sbor()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
Dim iStolb As Integer
   iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   Range("B3:P" & iLastRow).ClearContents
With Worksheets("1")
  For i = 3 To iLastRow
    Set FoundCell = .Columns(1).Find(Cells(i, 1), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
       Select Case FoundCell.Offset(, 1)
         Case "department_1"
           iStolb = 2
         Case "department_2"
           iStolb = 5
         Case "department_3"
           iStolb = 8
         Case "department_4"
           iStolb = 11
         Case "department_5"
           iStolb = 14
       End Select
        .Range(.Cells(FoundCell.Row, 3), .Cells(FoundCell.Row, 5)).Copy Cells(i, iStolb)
       Set FoundCell = .Columns(1).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
  Next
End With
End Sub
[/vba]
 
Ответить
СообщениеМакрос, запускать при активном листе "2"
[vba]
Код

Sub Sbor()
Dim i As Long
Dim iLastRow As Long
Dim FoundCell As Range
Dim FAdr As String
Dim iStolb As Integer
   iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
   Range("B3:P" & iLastRow).ClearContents
With Worksheets("1")
  For i = 3 To iLastRow
    Set FoundCell = .Columns(1).Find(Cells(i, 1), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
      FAdr = FoundCell.Address
      Do
       Select Case FoundCell.Offset(, 1)
         Case "department_1"
           iStolb = 2
         Case "department_2"
           iStolb = 5
         Case "department_3"
           iStolb = 8
         Case "department_4"
           iStolb = 11
         Case "department_5"
           iStolb = 14
       End Select
        .Range(.Cells(FoundCell.Row, 3), .Cells(FoundCell.Row, 5)).Copy Cells(i, iStolb)
       Set FoundCell = .Columns(1).FindNext(FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
  Next
End With
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 11.09.2017 в 11:46
iMrTidy Дата: Понедельник, 11.09.2017, 11:46 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 9 ±
Замечаний: 0% ±

Excel 2010
is_1, будет куда быстрее сначала скопировать все данные в массивы и производить все операции с массивами, а результат уже помещать на лист. Альтернативно, можно воспользоваться SQL запросом.
 
Ответить
Сообщениеis_1, будет куда быстрее сначала скопировать все данные в массивы и производить все операции с массивами, а результат уже помещать на лист. Альтернативно, можно воспользоваться SQL запросом.

Автор - iMrTidy
Дата добавления - 11.09.2017 в 11:46
is_1 Дата: Понедельник, 11.09.2017, 12:00 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Kuzmich, Спасибо большое, но я забыл указать еще один момент - количество отделов около 50. Для каждого писать конструкцию select case?
 
Ответить
СообщениеKuzmich, Спасибо большое, но я забыл указать еще один момент - количество отделов около 50. Для каждого писать конструкцию select case?

Автор - is_1
Дата добавления - 11.09.2017 в 12:00
nilem Дата: Понедельник, 11.09.2017, 12:41 | Сообщение № 5
Группа: Авторы
Ранг: Старожил
Сообщений: 1249
Репутация: 457 ±
Замечаний: 0% ±

Excel 2013
в качестве варианта


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениев качестве варианта

Автор - nilem
Дата добавления - 11.09.2017 в 12:41
is_1 Дата: Понедельник, 11.09.2017, 13:58 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 13
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
nilem, а можно прокомментировать код? Что-то я плохо понимаю как он работает и как его применить к своей задаче. Заранее спасибо!
 
Ответить
Сообщениеnilem, а можно прокомментировать код? Что-то я плохо понимаю как он работает и как его применить к своей задаче. Заранее спасибо!

Автор - is_1
Дата добавления - 11.09.2017 в 13:58
nilem Дата: Понедельник, 11.09.2017, 15:31 | Сообщение № 7
Группа: Авторы
Ранг: Старожил
Сообщений: 1249
Репутация: 457 ±
Замечаний: 0% ±

Excel 2013
как его применить к своей задаче

Просто вставьте код в стандартный модуль и запустите макрос. Названия листов и расположение диапазонов - как в вашем примере из пост №1


Яндекс.Деньги 4100159601573
 
Ответить
Сообщение
как его применить к своей задаче

Просто вставьте код в стандартный модуль и запустите макрос. Названия листов и расположение диапазонов - как в вашем примере из пост №1

Автор - nilem
Дата добавления - 11.09.2017 в 15:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сокращение времени работы макроса при сравнении столбцов (Макросы/Sub)
Страница 1 из 11
Поиск:

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