Простой ВПР двух таблиц макросом
w00t
Дата: Четверг, 26.05.2016, 21:34 |
Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация:
3
±
Замечаний:
0% ±
Сделал так [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(.Rows.Count, 3).End(xlUp).Row) For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), Sheets("Лист2").Range("A:C"), 3, False) Next End With End Sub
[/vba] - работает. Но ущербно. Например, если на втором листе не будет совпадений по просматриваемому столбцу - то вылетит с ошибкой "Невозможно получить свойство Vlookup класса WorksheetFunction. А вместо этого поставить бы прочерк (если не найдено совпадений). Возможно еще что-то не так. Посоветуйте, как оптимизировать код. Нужно то, что визуально в приложенной книге. Только диапазоны динамические и средней степени величины, по этой причине ищу последнюю строку. Вообще, была идея навесить на Worksheet.SelectionChange, поэтому пытаюсь понять, как сделать оптимальнее и проще.
Сделал так [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(.Rows.Count, 3).End(xlUp).Row) For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), Sheets("Лист2").Range("A:C"), 3, False) Next End With End Sub
[/vba] - работает. Но ущербно. Например, если на втором листе не будет совпадений по просматриваемому столбцу - то вылетит с ошибкой "Невозможно получить свойство Vlookup класса WorksheetFunction. А вместо этого поставить бы прочерк (если не найдено совпадений). Возможно еще что-то не так. Посоветуйте, как оптимизировать код. Нужно то, что визуально в приложенной книге. Только диапазоны динамические и средней степени величины, по этой причине ищу последнюю строку. Вообще, была идея навесить на Worksheet.SelectionChange, поэтому пытаюсь понять, как сделать оптимальнее и проще. w00t
Сообщение отредактировал w00t - Четверг, 26.05.2016, 21:41
Ответить
Сообщение Сделал так [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(.Rows.Count, 3).End(xlUp).Row) For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), Sheets("Лист2").Range("A:C"), 3, False) Next End With End Sub
[/vba] - работает. Но ущербно. Например, если на втором листе не будет совпадений по просматриваемому столбцу - то вылетит с ошибкой "Невозможно получить свойство Vlookup класса WorksheetFunction. А вместо этого поставить бы прочерк (если не найдено совпадений). Возможно еще что-то не так. Посоветуйте, как оптимизировать код. Нужно то, что визуально в приложенной книге. Только диапазоны динамические и средней степени величины, по этой причине ищу последнюю строку. Вообще, была идея навесить на Worksheet.SelectionChange, поэтому пытаюсь понять, как сделать оптимальнее и проще. Автор - w00t Дата добавления - 26.05.2016 в 21:34
Manyasha
Дата: Четверг, 26.05.2016, 21:52 |
Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация:
898
±
Замечаний:
0% ±
Excel 2010, 2016
w00t , так хотите? [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row) On Error Resume Next For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), _ Sheets("Лист2").Range("A2:C" & Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row), 3, False) If Err <> 0 Then rng.Cells(i, 6) = "-": Err.Clear Next End With End Sub
[/vba] А чем формула не угодила?
w00t , так хотите? [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row) On Error Resume Next For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), _ Sheets("Лист2").Range("A2:C" & Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row), 3, False) If Err <> 0 Then rng.Cells(i, 6) = "-": Err.Clear Next End With End Sub
[/vba] А чем формула не угодила?Manyasha
ЯД: 410013299366744 WM: R193491431804
Ответить
Сообщение w00t , так хотите? [vba]Код
Sub Test() Dim rng As Range Dim i As Long With ActiveSheet Set rng = .Range("C1:C" & .Cells(Rows.Count, 3).End(xlUp).Row) On Error Resume Next For i = 5 To rng.Rows.Count rng.Cells(i, 6) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i, 3), _ Sheets("Лист2").Range("A2:C" & Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row), 3, False) If Err <> 0 Then rng.Cells(i, 6) = "-": Err.Clear Next End With End Sub
[/vba] А чем формула не угодила?Автор - Manyasha Дата добавления - 26.05.2016 в 21:52
_Boroda_
Дата: Четверг, 26.05.2016, 22:00 |
Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
Еще вариант [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("D" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-1],Лист2!R2C[-3]:R" & r11_ & "C[-1],3,0),""-"")" Range("D" & r0_).Resize(r1_ - r0_ + 1).Copy Range("D" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba]Формулой (в коде или сразу на листе) - долго
Вы знаете, сомнения смутные меня гнетут, что макрос будет быстрее формулы. В макросе-то тот же VLOOKUP. Проверить можно, но лениво.
Еще вариант [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("D" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-1],Лист2!R2C[-3]:R" & r11_ & "C[-1],3,0),""-"")" Range("D" & r0_).Resize(r1_ - r0_ + 1).Copy Range("D" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba]Формулой (в коде или сразу на листе) - долго
Вы знаете, сомнения смутные меня гнетут, что макрос будет быстрее формулы. В макросе-то тот же VLOOKUP. Проверить можно, но лениво. _Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение Еще вариант [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("D" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-1],Лист2!R2C[-3]:R" & r11_ & "C[-1],3,0),""-"")" Range("D" & r0_).Resize(r1_ - r0_ + 1).Copy Range("D" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba]Формулой (в коде или сразу на листе) - долго
Вы знаете, сомнения смутные меня гнетут, что макрос будет быстрее формулы. В макросе-то тот же VLOOKUP. Проверить можно, но лениво. Автор - _Boroda_ Дата добавления - 26.05.2016 в 22:00
w00t
Дата: Четверг, 26.05.2016, 22:01 |
Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация:
3
±
Замечаний:
0% ±
Да,так, спасибо :) Формулой (в коде или сразу на листе) - долго, как минимум (на среднем диапазоне). И диапазон динамический, только первая строка фиксирована. Очень редко пользуюсь именно таким способом, бывает необходим. Обычно для небольших диапазонов формула, либо для очень больших - более специализированная штука есть.
Да,так, спасибо :) Формулой (в коде или сразу на листе) - долго, как минимум (на среднем диапазоне). И диапазон динамический, только первая строка фиксирована. Очень редко пользуюсь именно таким способом, бывает необходим. Обычно для небольших диапазонов формула, либо для очень больших - более специализированная штука есть. w00t
Ответить
Сообщение Да,так, спасибо :) Формулой (в коде или сразу на листе) - долго, как минимум (на среднем диапазоне). И диапазон динамический, только первая строка фиксирована. Очень редко пользуюсь именно таким способом, бывает необходим. Обычно для небольших диапазонов формула, либо для очень больших - более специализированная штука есть. Автор - w00t Дата добавления - 26.05.2016 в 22:01
w00t
Дата: Четверг, 26.05.2016, 22:50 |
Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация:
3
±
Замечаний:
0% ±
Спасибо, поправил на свой диапазон [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba] Только CutCopyMode убирает рамку, но оставляет выделение диапазона. Пока не догуглил, как просто убрать выделение, без выбора какой-то левой другой ячейки.
Спасибо, поправил на свой диапазон [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba] Только CutCopyMode убирает рамку, но оставляет выделение диапазона. Пока не догуглил, как просто убрать выделение, без выбора какой-то левой другой ячейки. w00t
Сообщение отредактировал w00t - Четверг, 26.05.2016, 23:05
Ответить
Сообщение Спасибо, поправил на свой диапазон [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 End Sub
[/vba] Только CutCopyMode убирает рамку, но оставляет выделение диапазона. Пока не догуглил, как просто убрать выделение, без выбора какой-то левой другой ячейки. Автор - w00t Дата добавления - 26.05.2016 в 22:50
Serge_007
Дата: Четверг, 26.05.2016, 23:06 |
Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация:
2748
±
Замечаний:
±
Excel 2016
как просто убрать выделение, без выбора какой-то левой другой ячейки
А никак Какая-то ячейка всегда должна быть активной А значит выделение (фокус) будет переведено на активную ячейку, иначе никак...
как просто убрать выделение, без выбора какой-то левой другой ячейки
А никак Какая-то ячейка всегда должна быть активной А значит выделение (фокус) будет переведено на активную ячейку, иначе никак...Serge_007
ЮMoney :41001419691823 | WMR :126292472390
Ответить
Сообщение как просто убрать выделение, без выбора какой-то левой другой ячейки
А никак Какая-то ячейка всегда должна быть активной А значит выделение (фокус) будет переведено на активную ячейку, иначе никак...Автор - Serge_007 Дата добавления - 26.05.2016 в 23:06
w00t
Дата: Четверг, 26.05.2016, 23:11 |
Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 131
Репутация:
3
±
Замечаний:
0% ±
Вроде выкрутился [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False 'Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) End Sub
[/vba]
Вроде выкрутился [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False 'Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) End Sub
[/vba] w00t
Ответить
Сообщение Вроде выкрутился [vba]Код
Sub tt() Application.ScreenUpdating = 0 r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False 'Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) End Sub
[/vba] Автор - w00t Дата добавления - 26.05.2016 в 23:11
_Boroda_
Дата: Четверг, 26.05.2016, 23:26 |
Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация:
6478
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
Как-то Вы странно выкрутились. 1. [vba][/vba]дольше, чем [vba]Код
Range.Copy Range.PasteSpecial (xlPasteValues)
[/vba]А Вы вроде писали, что делаете такой финт именно для повышения скорости 2. Зачем тогда строка [vba]Код
Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False
[/vba] Если выделение мешает, то можно возвратить обратно то выделение, которое было до запуска макроса [vba]Код
Sub tt() Application.ScreenUpdating = 0 ad_ = Selection.Address r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" ' Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 Range(ad_).Select End Sub
[/vba]
Как-то Вы странно выкрутились. 1. [vba][/vba]дольше, чем [vba]Код
Range.Copy Range.PasteSpecial (xlPasteValues)
[/vba]А Вы вроде писали, что делаете такой финт именно для повышения скорости 2. Зачем тогда строка [vba]Код
Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False
[/vba] Если выделение мешает, то можно возвратить обратно то выделение, которое было до запуска макроса [vba]Код
Sub tt() Application.ScreenUpdating = 0 ad_ = Selection.Address r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" ' Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 Range(ad_).Select End Sub
[/vba]_Boroda_
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение Как-то Вы странно выкрутились. 1. [vba][/vba]дольше, чем [vba]Код
Range.Copy Range.PasteSpecial (xlPasteValues)
[/vba]А Вы вроде писали, что делаете такой финт именно для повышения скорости 2. Зачем тогда строка [vba]Код
Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1): Application.CutCopyMode = False
[/vba] Если выделение мешает, то можно возвратить обратно то выделение, которое было до запуска макроса [vba]Код
Sub tt() Application.ScreenUpdating = 0 ad_ = Selection.Address r11_ = Sheets("Лист2").Range("A" & Rows.Count).End(3).Row r1_ = Range("C" & Rows.Count).End(3).Row r0_ = 5 Range("H" & r0_).Resize(r1_ - r0_ + 1).FormulaR1C1 = _ "=IFERROR(VLOOKUP(RC[-5],Лист2!R2C[-7]:R" & r11_ & "C[-5],3,0),""-"")" ' Range("H" & r0_).Resize(r1_ - r0_ + 1).Value = Range("H" & r0_).Resize(r1_ - r0_ + 1).Value Range("H" & r0_).Resize(r1_ - r0_ + 1).Copy Range("H" & r0_).Resize(r1_ - r0_ + 1).PasteSpecial (xlPasteValues) Application.CutCopyMode = 0 Range(ad_).Select End Sub
[/vba]Автор - _Boroda_ Дата добавления - 26.05.2016 в 23:26