Поиск в другой книге

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в другой книге (Макросы/Sub)

Venique

Дата: Четверг, 06.11.2014, 14:57 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 38

Репутация: 0 ±

Замечаний: 20% ±

Excel 2003

Приветствую! Помогите реализовать такой макрос...

Есть Книга №1, в ней лист с данными. В диапазоне A1:A5000 занесены числовые значения. Рядом с каждой ячейкой расположена кнопка. При нажатии на неё должен начаться поиск этого же значения в отдельной книге "Книга №2" на листе "Лист №1" в диапазоне ячеек B1:B5000. Как только будет совпадение (а оно будет лишь один раз, так как во второй книге значения уникальны), фокус должен встать на эту ячейку в этой книге.

Если проще - в первой книге я завожу инцидент с номером устройства, по клике на кнопку у меня открывается вторая книга и фокус встает на ячейку с этим же номером, где есть полное описание устройства. Для наглядности прикладываю файл.

К сообщению приложен файл: 7379798.xls (18.5 Kb)

Сообщение отредактировал Venique - Четверг, 06.11.2014, 15:01

Ответить

Rioran

Дата: Четверг, 06.11.2014, 16:36 | Сообщение № 2

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

Venique, здравствуйте.

Для реализации макроса рекомендую сделать только одну кнопку. Её поместить на верхнюю строку. Строку закрепить (через меню "Вид"). Сама кнопка будет работать с выделенной ячейкой. Это избавляет от потрясающей перспективы клонировать кнопку 5 тысяч раз.

Для открытия книги изучите метод Workbooks.Open, для поиска значения - Range( ... ).Find. Для "постановки фокуса" достаточно Cells( ... ).Select. Где троеточия - ваши специфичные данные.

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Ответить

Alex_ST

Дата: Четверг, 06.11.2014, 22:34 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3209

Репутация: 609 ±

Замечаний: 0% ±

2003

Да вообще зачем кнопки?[vba]

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     If Not Intersect(Target, [A1:A5000]) Is Nothing Then
         Cancel = True
         '.....
     End If
End Sub

[/vba]

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Rioran

Дата: Пятница, 07.11.2014, 09:12 | Сообщение № 4

Группа: Авторы

Ранг: Ветеран

Сообщений: 903

Репутация: 290 ±

Замечаний: 0% ±

Excel 2013

Цитата Alex_ST, 06.11.2014 в 22:34, в сообщении № 3

Worksheet_BeforeDoubleClick

Кстати да, вешать макрос на двойной клик тут будет оптимальнее =)

Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279

Ответить

Venique

Дата: Среда, 12.11.2014, 17:34 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 38

Репутация: 0 ±

Замечаний: 20% ±

Excel 2003

Да, отдельная кнопка оказалась оптимальнее, а вот двойной клик - нет, т.к. в эту ячейку перед поиском ещё и само значение забить надо. Покопался подольше, нежели чем с готовым вариантом, но получилось неплохо. Если кому-то будет полезно, то вот:

[vba]

Код

Sub CrossSearch()

'задаём переменные
Dim GCell As Range
Dim Txt$
Dim wBook As Workbook

'что ищем
Txt = ActiveCell.Value

'продолжаем выполнять макрос, иначе без открытой книги он прервётся
On Error Resume Next

'описываем книгу
Set wBook = Workbooks("Book2.xls")
Application.ScreenUpdating = False 'немного ускорим процесс
      If wBook Is Nothing Then 'если она не открыта, то открываем её
          Workbooks.Open Filename:= _
          "\\***\Book2.xls"
          Set GCell = Sheets("Лист1").Range("B2:B1000").Find(What:=Txt, LookIn:=xlValues, LookAt:=xlWhole) 'производим поиск полного совпадения
          If GCell Is Nothing Then
              MsgBox "ID " & Txt & " не найден.", vbOKOnly + vbCritical, "Поиск в Book2"
              Application.ScreenUpdating = True
              Workbooks("Book1.xls").Activate
          Else
              Workbooks("Book2.xls").Activate 'выводим на передний план
              Application.ScreenUpdating = True
              ActiveSheet.Range(GCell, GCell.Offset(0, 3)).Select 'а затем выделяем найденный результат
          End If
      Else 'если она открыта
          Set GCell = wBook.Sheets("Лист1").Range("B2:B1000").Find(What:=Txt, LookIn:=xlValues, LookAt:=xlWhole) 'производим поиск полного совпадения
          If GCell Is Nothing Then
              MsgBox "ID " & Txt & " не найден.", vbOKOnly + vbCritical, "Поиск в Book2"
              Application.ScreenUpdating = True
          Else
              Workbooks("Book2.xls").Activate 'выводим на передний план
              Application.ScreenUpdating = True
              ActiveSheet.Range(GCell, GCell.Offset(0, 3)).Select 'а затем выделяем найденный результат
          End If
      End If

Exit Sub
End Sub

[/vba]

Макрос ищет выделенное в текущий момент значение ячейки из книги Book1 в книге Book2, в диапазоне B1:B1000. Если совпадение есть - делает фокус на Book2 и подсвечивает ячейку с искомым значением +3 ячейки вправо (у меня там сопроводительная информация лежит). Если совпадения нет - выдаёт ошибку. Если книга не открыта - сначала открывает, а потом уже ищет. Окошко с ошибкой сделал покрасивше, путь можно прописывать вплоть до файла на удалённом сервере. Все кейсы отработал, вроде накладок не возникает, так что можно пользоваться

Вешать макрос на отдельную кнопку.

Код

Вешать макрос на отдельную кнопку.Venique

Сообщение отредактировал Venique - Среда, 12.11.2014, 17:36

Ответить

СообщениеДа, отдельная кнопка оказалась оптимальнее, а вот двойной клик - нет, т.к. в эту ячейку перед поиском ещё и само значение забить надо. Покопался подольше, нежели чем с готовым вариантом, но получилось неплохо. Если кому-то будет полезно, то вот:

[vba]

Код

Вешать макрос на отдельную кнопку.

Автор - Venique
Дата добавления - 12.11.2014 в 17:34

RoViX

Дата: Среда, 18.01.2017, 11:11 | Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Venique, тут напрашивается маленькая оптимизация.
У Вас основные операции дублируются, нехорошо это. Если потребуется изменить алгоритм действий, то править придется в двух местах.
Лучше сделать так:
[vba]

Код

Sub CrossSearch()
    'задаём переменные
    Dim GCell As Range
    Dim Txt$
    Dim wBook As Workbook

    'что ищем
    Txt = ActiveCell.Value

    'продолжаем выполнять макрос, иначе без открытой книги он прервётся
    On Error Resume Next

    'описываем книгу
    sBookName = "Book2.xls"
    sBookPath = "\\***\"
    Set wBook = Workbooks(sBookName)
    Application.ScreenUpdating = False 'немного ускорим процесс

    If wBook Is Nothing Then 'если она не открыта, то открываем её
        Workbooks.Open Filename:= sBookPath & sBookName
    End If

    Set GCell = wBook.Sheets("Лист1").Range("B2:B1000").Find(What:=Txt, LookIn:=xlValues, LookAt:=xlWhole) 'производим поиск полного совпадения
    If GCell Is Nothing Then
        MsgBox "ID " & Txt & " не найден.", vbOKOnly + vbCritical, "Поиск в Book2"
        Application.ScreenUpdating = True
    Else
        Workbooks("Book2.xls").Activate 'выводим на передний план
        Application.ScreenUpdating = True
        ActiveSheet.Range(GCell, GCell.Offset(0, 3)).Select 'а затем выделяем найденный результат
    End If

End Sub

[/vba]

Exit Sub перед End Sub тоже лишнее.

Ответить

Alex_ST

Дата: Среда, 18.01.2017, 11:42 | Сообщение № 7

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3209

Репутация: 609 ±

Замечаний: 0% ±

2003

RoViX, а Вас не смущает, что пост с критикуемым Вами макросом Venique выложил больше двух лет назад, 12.11.2014, а судя по профилю, после 15.12.2014 здесь не появлялся?

С уважением,
Алексей
MS Excel 2003 - the best!!!

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск в другой книге (Макросы/Sub)

Страница 1 из 1
1