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

Вход

Регистрация

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

 

= Мир MS Excel/Простой ВПР двух таблиц макросом - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Простой ВПР двух таблиц макросом (Макросы/Sub)
Простой ВПР двух таблиц макросом
w00t Дата: Четверг, 26.05.2016, 21:34 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 127
Репутация: 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, поэтому пытаюсь понять, как сделать оптимальнее и проще.
К сообщению приложен файл: 6920410.xlsm(19Kb)


Сообщение отредактировал 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
Группа: Модераторы
Ранг: Старожил
Сообщений: 1822
Репутация: 758 ±
Замечаний: 0% ±

Excel 2007, 2010
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]
А чем формула не угодила?


marinamorozova_box@mail.ru
ЯД: 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
Группа: Модераторы
Ранг: Экселист
Сообщений: 10334
Репутация: 4357 ±
Замечаний: 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. Проверить можно, но лениво.
К сообщению приложен файл: 6920410_1.xlsm(19Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 127
Репутация: 3 ±
Замечаний: 0% ±

Да,так, спасибо :)
Формулой (в коде или сразу на листе) - долго, как минимум (на среднем диапазоне). И диапазон динамический, только первая строка фиксирована.
Очень редко пользуюсь именно таким способом, бывает необходим. Обычно для небольших диапазонов формула, либо для очень больших - более специализированная штука есть.
 
Ответить
СообщениеДа,так, спасибо :)
Формулой (в коде или сразу на листе) - долго, как минимум (на среднем диапазоне). И диапазон динамический, только первая строка фиксирована.
Очень редко пользуюсь именно таким способом, бывает необходим. Обычно для небольших диапазонов формула, либо для очень больших - более специализированная штука есть.

Автор - w00t
Дата добавления - 26.05.2016 в 22:01
_Boroda_ Дата: Четверг, 26.05.2016, 22:10 | Сообщение № 5
Группа: Модераторы
Ранг: Экселист
Сообщений: 10334
Репутация: 4357 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
В коде выше накосячил. Исправил и файл перевложил


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВ коде выше накосячил. Исправил и файл перевложил

Автор - _Boroda_
Дата добавления - 26.05.2016 в 22:10
w00t Дата: Четверг, 26.05.2016, 22:50 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 127
Репутация: 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 убирает рамку, но оставляет выделение диапазона. Пока не догуглил, как просто убрать выделение, без выбора какой-то левой другой ячейки.


Сообщение отредактировал 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 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 13121
Репутация: ±
Замечаний: ±

Excel 2010
как просто убрать выделение, без выбора какой-то левой другой ячейки
А никак
Какая-то ячейка всегда должна быть активной
А значит выделение (фокус) будет переведено на активную ячейку, иначе никак...


Яндекс-деньги:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
как просто убрать выделение, без выбора какой-то левой другой ячейки
А никак
Какая-то ячейка всегда должна быть активной
А значит выделение (фокус) будет переведено на активную ячейку, иначе никак...

Автор - Serge_007
Дата добавления - 26.05.2016 в 23:06
w00t Дата: Четверг, 26.05.2016, 23:11 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 127
Репутация: 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
Дата добавления - 26.05.2016 в 23:11
_Boroda_ Дата: Четверг, 26.05.2016, 23:26 | Сообщение № 9
Группа: Модераторы
Ранг: Экселист
Сообщений: 10334
Репутация: 4357 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Вроде выкрутился

Как-то Вы странно выкрутились.
1. [vba]
Код
Range=Range.Value
[/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_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Вроде выкрутился

Как-то Вы странно выкрутились.
1. [vba]
Код
Range=Range.Value
[/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
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Простой ВПР двух таблиц макросом (Макросы/Sub)
Страница 1 из 11
Поиск:

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