Здравствуйте! Прошу помочь в решении такой задачи: (придется описывать, т.к. файл большой и прикрепить не получится) в таблицах содержится информация для грузоперевозок: пункт отправки-пункт прибытия-количество-цена. имеется таблица ЛИСТ1, в которой 26776 строк, и таблица ТАРИФЫ, в которой 145462 строк. Обе таблицы идентичные. необходимо сравнивать 3 столбца каждой таблицы (город загрузки, город выгрузки, количество) и при полном совпадении переносить из столбца с ценой таблицы ЛИСТ1 в таблицу ТАРИФЫ. для выполнения задачи сделал вот такой макрос:
Sub перенос() For i = 2To26776 For j = 3To145462 If Sheets("Лист1").Cells(i, 1) = Sheets("Тарифы").Cells(j, 1) And Sheets("Лист1").Cells(i, 3) = Sheets("Тарифы").Cells(j, 3) And Sheets("Лист1").Cells(i, 4) = Sheets("Тарифы").Cells(j, 4) Then
Sheets("Тарифы").Cells(j, 5) = Sheets("Лист1").Cells(i, 6) ExitFor EndIf Next j Next i EndSub
при ручном выполнении (пошаговом при нажатии f8) перенос производится, но очень медленно, т.к. большое количество строк. При запуске макроса перенос идет быстро, но секунд 10 и потом excel зависает. Подскажите, что не так делаю, может быть есть какая-то формула для такой цели, либо можно как то упростить макрос (хотя куда уж проще). Подскажите пожалуйста! Заранее спасибо
Здравствуйте! Прошу помочь в решении такой задачи: (придется описывать, т.к. файл большой и прикрепить не получится) в таблицах содержится информация для грузоперевозок: пункт отправки-пункт прибытия-количество-цена. имеется таблица ЛИСТ1, в которой 26776 строк, и таблица ТАРИФЫ, в которой 145462 строк. Обе таблицы идентичные. необходимо сравнивать 3 столбца каждой таблицы (город загрузки, город выгрузки, количество) и при полном совпадении переносить из столбца с ценой таблицы ЛИСТ1 в таблицу ТАРИФЫ. для выполнения задачи сделал вот такой макрос:
Sub перенос() For i = 2To26776 For j = 3To145462 If Sheets("Лист1").Cells(i, 1) = Sheets("Тарифы").Cells(j, 1) And Sheets("Лист1").Cells(i, 3) = Sheets("Тарифы").Cells(j, 3) And Sheets("Лист1").Cells(i, 4) = Sheets("Тарифы").Cells(j, 4) Then
Sheets("Тарифы").Cells(j, 5) = Sheets("Лист1").Cells(i, 6) ExitFor EndIf Next j Next i EndSub
при ручном выполнении (пошаговом при нажатии f8) перенос производится, но очень медленно, т.к. большое количество строк. При запуске макроса перенос идет быстро, но секунд 10 и потом excel зависает. Подскажите, что не так делаю, может быть есть какая-то формула для такой цели, либо можно как то упростить макрос (хотя куда уж проще). Подскажите пожалуйста! Заранее спасибоiluha2190
Сообщение отредактировал iluha2190 - Среда, 09.08.2017, 12:25
Проще всего сцепить все столбцы через разделитель и формулой вытащить. 27000 х 150000 - это не так уж и много Формулу потом (если тормозить будет) можно скопировать и вставить значением
В макросах (да и не только в них) не простота важна, а эффективность
Проще всего сцепить все столбцы через разделитель и формулой вытащить. 27000 х 150000 - это не так уж и много Формулу потом (если тормозить будет) можно скопировать и вставить значением
Если делать макросами - то вот такой вариант, наверное, будет самый быстродействующий:
Sub test01()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
Set oTable = ThisWorkbook.Worksheets("Лист1").[a2].CurrentRegion If oTable.Row < 2ThenSet oTable = oTable.Offset(2 - oTable.Row).Resize(oTable.Rows.Count - (2 - oTable.Row))
aTable = oTable.Value For i = LBound(aTable) ToUBound(aTable)
dKey = aTable(i, 1) & "|" & aTable(i, 3) & "|" & aTable(i, 4)
dic(dKey) = aTable(i, 6) Next
Set oTable = ThisWorkbook.Worksheets("Тарифы").[a3].CurrentRegion If oTable.Row < 3ThenSet oTable = oTable.Offset(3 - oTable.Row).Resize(oTable.Rows.Count - (3 - oTable.Row))
aTable = oTable.Value For i = LBound(aTable) ToUBound(aTable)
dKey = aTable(i, 1) & "|" & aTable(i, 3) & "|" & aTable(i, 4) If dic.exists(dKey) Then aTable(i, 5) = dic(dKey) Next
oTable.Value = aTable
EndSub
По сути, мы здесь делаем то же самое ("..ключ - это сцепить все столбцы условия через разделитель..."), и затем подставляем, только безо всяких вложенных циклов, так что количество операций линейно, и равно суммарному количеству строк в обеих таблицах...
Если делать макросами - то вот такой вариант, наверное, будет самый быстродействующий:
Sub test01()
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
Set oTable = ThisWorkbook.Worksheets("Лист1").[a2].CurrentRegion If oTable.Row < 2ThenSet oTable = oTable.Offset(2 - oTable.Row).Resize(oTable.Rows.Count - (2 - oTable.Row))
aTable = oTable.Value For i = LBound(aTable) ToUBound(aTable)
dKey = aTable(i, 1) & "|" & aTable(i, 3) & "|" & aTable(i, 4)
dic(dKey) = aTable(i, 6) Next
Set oTable = ThisWorkbook.Worksheets("Тарифы").[a3].CurrentRegion If oTable.Row < 3ThenSet oTable = oTable.Offset(3 - oTable.Row).Resize(oTable.Rows.Count - (3 - oTable.Row))
aTable = oTable.Value For i = LBound(aTable) ToUBound(aTable)
dKey = aTable(i, 1) & "|" & aTable(i, 3) & "|" & aTable(i, 4) If dic.exists(dKey) Then aTable(i, 5) = dic(dKey) Next
oTable.Value = aTable
EndSub
По сути, мы здесь делаем то же самое ("..ключ - это сцепить все столбцы условия через разделитель..."), и затем подставляем, только безо всяких вложенных циклов, так что количество операций линейно, и равно суммарному количеству строк в обеих таблицах...AndreTM
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
