Здравствуйте! Прошу помочь в решении такой задачи: (придется описывать, т.к. файл большой и прикрепить не получится) в таблицах содержится информация для грузоперевозок: пункт отправки-пункт прибытия-количество-цена. имеется таблица ЛИСТ1, в которой 26776 строк, и таблица ТАРИФЫ, в которой 145462 строк. Обе таблицы идентичные. необходимо сравнивать 3 столбца каждой таблицы (город загрузки, город выгрузки, количество) и при полном совпадении переносить из столбца с ценой таблицы ЛИСТ1 в таблицу ТАРИФЫ. для выполнения задачи сделал вот такой макрос: [vba]
Код
Sub перенос() For i = 2 To 26776 For j = 3 To 145462 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) Exit For End If Next j Next i End Sub
[/vba] при ручном выполнении (пошаговом при нажатии f8) перенос производится, но очень медленно, т.к. большое количество строк. При запуске макроса перенос идет быстро, но секунд 10 и потом excel зависает. Подскажите, что не так делаю, может быть есть какая-то формула для такой цели, либо можно как то упростить макрос (хотя куда уж проще). Подскажите пожалуйста! Заранее спасибо
Здравствуйте! Прошу помочь в решении такой задачи: (придется описывать, т.к. файл большой и прикрепить не получится) в таблицах содержится информация для грузоперевозок: пункт отправки-пункт прибытия-количество-цена. имеется таблица ЛИСТ1, в которой 26776 строк, и таблица ТАРИФЫ, в которой 145462 строк. Обе таблицы идентичные. необходимо сравнивать 3 столбца каждой таблицы (город загрузки, город выгрузки, количество) и при полном совпадении переносить из столбца с ценой таблицы ЛИСТ1 в таблицу ТАРИФЫ. для выполнения задачи сделал вот такой макрос: [vba]
Код
Sub перенос() For i = 2 To 26776 For j = 3 To 145462 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) Exit For End If Next j Next i End Sub
[/vba] при ручном выполнении (пошаговом при нажатии f8) перенос производится, но очень медленно, т.к. большое количество строк. При запуске макроса перенос идет быстро, но секунд 10 и потом excel зависает. Подскажите, что не так делаю, может быть есть какая-то формула для такой цели, либо можно как то упростить макрос (хотя куда уж проще). Подскажите пожалуйста! Заранее спасибоiluha2190
Сообщение отредактировал iluha2190 - Среда, 09.08.2017, 12:25
Проще всего сцепить все столбцы через разделитель и формулой вытащить. 27000 х 150000 - это не так уж и много Формулу потом (если тормозить будет) можно скопировать и вставить значением
В макросах (да и не только в них) не простота важна, а эффективность
Проще всего сцепить все столбцы через разделитель и формулой вытащить. 27000 х 150000 - это не так уж и много Формулу потом (если тормозить будет) можно скопировать и вставить значением
Если делать макросами - то вот такой вариант, наверное, будет самый быстродействующий: [vba]
Код
Sub test01()
Set dic = CreateObject("Scripting.Dictionary") dic.CompareMode = 1
Set oTable = ThisWorkbook.Worksheets("Лист1").[a2].CurrentRegion If oTable.Row < 2 Then Set oTable = oTable.Offset(2 - oTable.Row).Resize(oTable.Rows.Count - (2 - oTable.Row)) aTable = oTable.Value For i = LBound(aTable) To UBound(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 < 3 Then Set oTable = oTable.Offset(3 - oTable.Row).Resize(oTable.Rows.Count - (3 - oTable.Row)) aTable = oTable.Value For i = LBound(aTable) To UBound(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
End Sub
[/vba] По сути, мы здесь делаем то же самое ("..ключ - это сцепить все столбцы условия через разделитель..."), и затем подставляем, только безо всяких вложенных циклов, так что количество операций линейно, и равно суммарному количеству строк в обеих таблицах...
Если делать макросами - то вот такой вариант, наверное, будет самый быстродействующий: [vba]
Код
Sub test01()
Set dic = CreateObject("Scripting.Dictionary") dic.CompareMode = 1
Set oTable = ThisWorkbook.Worksheets("Лист1").[a2].CurrentRegion If oTable.Row < 2 Then Set oTable = oTable.Offset(2 - oTable.Row).Resize(oTable.Rows.Count - (2 - oTable.Row)) aTable = oTable.Value For i = LBound(aTable) To UBound(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 < 3 Then Set oTable = oTable.Offset(3 - oTable.Row).Resize(oTable.Rows.Count - (3 - oTable.Row)) aTable = oTable.Value For i = LBound(aTable) To UBound(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
End Sub
[/vba] По сути, мы здесь делаем то же самое ("..ключ - это сцепить все столбцы условия через разделитель..."), и затем подставляем, только безо всяких вложенных циклов, так что количество операций линейно, и равно суммарному количеству строк в обеих таблицах...AndreTM