Страницы: 1
RSS
Выполнить поиск по значению InputBox в другой книге
 
Добрый день уважаемые форумчане!
Возник вопрос - проблема.
Есть 2 книги. В одной база с определнными данными. В ячейках B8:B521 стоят номера. С D8 по K521 различные данные (ФИО, возраст и т.п.)
Во второй книге небольшая выборка из этой базы. определнные номера и их данные, скопированные из 1 книги.
Хочу сделать через InputBox поиск номера, который еще не был ранее скопирован во 2 таблицу. Заранее не знаю, поэтому inputBox и ввожу сам нужный номер.
Написал Код.
В определнных вкладках 2й книги прописал путь и имя 1 книги (определяю с помощью формул - пстр, найти и различных махинаций с ними).
Теперь пытаюсь проверить открыта ли 1 книга или нет, если нет то открываю, а если открыта то сразу приступаю к поиску нужной строки для копирования.
Если книга уже была открыта, то проблем нет, все ищется и копируется, а вот если она была закрыта, то поиск не работает.
Подскажите, как можно поправить код, чтобы все работало корректно?
Скрытый текст

Обнаружил, что если книга закрыта, то при отсутствии строки On Error Resume Next, ругается на subscript out of range.....
Изменено: VVS_001 - 22.01.2020 15:24:59
 
А книга открывается?
 
Когда On Error Resume Next стоит, открывается, но поиск выдает, что Gcell = Nothing и уходит из макроса.
Доходит до того, что, если я 2 раза подряд запущу макрос, то сперва он откроет книгу и ничего не найдет, а второй раз найдет, потому что книгу открыл в первый раз.
 
Сначала открывайте книгу, а потом Set. У Вас же наоборот.
 
Юрий, если честно не совсем понял о каком Set идет речь.
 
Код
Set wBook = Workbooks.Open(sBookPath & sBookName)
 
Пушка!
Спасибо МатросНаЗебре и Юрий М за помощь!
 
Уважаемые форумчане, оказалось что проблема решена не до конца...
Дело в том, что если книга с данными была отркыта до того как я открыл файл с выборкой, то поиск все равно ведет себя неадкватно, и не находит значение.
Получается, если я открыл вторую книгу, запустил макрос, а первая была закрыта, все ок. Если после этого я не закрыл первую и еще раз начал поиск, то тоже все ок, Но если сперва была открыта первая, потом я открыл 2, то все заработает только после закрытия первой. Есть ли возможность как это исправить?  

Часть кода с поиском выглядит сейчас вот так:
Скрытый текст

А переменная вынесена вне макроса, и задана как public.
Изменено: VVS_001 - 27.01.2020 18:04:19
 
Нужно явно указывать ячейки какой книги подразумеваете в строках там в середине кода (считать лень, код не оформлен...)
 
Hugo, Можете чуть более подробно? когда идет поиск я же вроде указываю, что книга такая-то, колонка такая-то, значние из переменно найти...
Скрытый текст

А следующая строка, говорит, что если не найдено, что вывести сообщение и выйти из макроса.
Цитата
Hugo написал:
считать лень, код не оформлен...

Если надо офромить код, для Вашего удобства, что надо сделать?
проставить номера строк?
 
Предположу, что нужно указать книгу и лист в строках:
Код
    sBookName = Range("Р!J2").Value & ".xls"
    sBookPath = Range("И!G1").Value
Вроде
Код
    sBookName = ThisWorkbook.Sheets("Р").Range("Р!J2").Value & ".xls"
    sBookPath = ThisWorkbook.Sheets("Р").Range("И!G1").Value
 
МатросНаЗебре, к сожалению это ничего не изменило. Да наверно и не могло, так как это нужно для открытия книги, или активации, а с этим проблем нет.
Проблема как мне кажется в том, что почему то не определяется переменная...но если файл открыт этим же макросом, то переменная определяется..

Убрал строку on error resume next
Теперь если 1 книга была ранее открыта  пишет object required.
Если была закрыта открывает и все норм ищет.
 
Цитата
VVS_001 написал:
если 1 книга была ранее открыта  пишет object required.
- возможно книги открыты в разных экземплярах приложениях.
Ну а по оформлению - если код оформлен, то там есть номера строк, и никому их считать не нужно, чтоб указать где возможна ошибка.
Вот в этих двух строках - ну совершенно по коду не понятно в какой книге берёте эти значения.
Изменено: Hugo - 27.01.2020 19:04:25
 
Уважаемый Hugo,

Цитата
Hugo написал:
- возможно книги открыты в разных экземплярах приложениях.
Можете пояснить как можно решить проблему в случае если это так.

Цитата
Hugo написал:
Ну а по оформлению - если код оформлен, то там есть номера строк, и никому их считать не нужно, чтоб указать где возможна ошибка.

Выкладываю офромленный (и измененный код) для удобства:
Код
Public iResult As String
 
Private Sub Добавить_участника_в_регу()
    iResult = InputBox("Укажите номер участника, который надо добавить", "Введите значение нужного действия!")
    If iResult = "" Then 'If Len(iResult) = 0 Then
    MsgBox "Ни одного значения не введено!", vbCritical
    ElseIf iResult <> 0 Then
    On Error Resume Next
    
    Set check = ThisWorkbook.Sheets("Р").Columns("A:A").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole)
    If check Is Nothing Then
    
    sBookName = ThisWorkbook.Sheets("Р").Range("J2").Value & ".xls"
    sBookPath = ThisWorkbook.Sheets("И").Range("G1").Value
    
    
    If wBook Is Nothing Then
    Set wBook = Workbooks.Open(sBookPath & sBookName)
    End If

    Workbooks(ThisWorkbook.Sheets("Р").Range("J2").Value & ".xls").Activate
    Set GCell = wBook.Sheets("Регистрация").Columns("B:B").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole)
    If GCell Is Nothing Then
    MsgBox "Участник " & iResult & " не найден в регистрации", vbExclamation, "Ошибка"
    ThisWorkbook.Activate
    Application.ScreenUpdating = True
    End
    Else
    Workbooks(ThisWorkbook.Sheets("Р").Range("J2").Value & ".xls").Activate
    ActiveSheet.Range(GCell, GCell.Offset(0, 9)).Copy
    ThisWorkbook.Activate
    Sheets("Р").Select
    Rows("6:135").Hidden = False
    Range("Р!A6").Select
    Dim lLastRow As Long
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A" & lLastRow + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("6:134").Select
    Selection.Sort Key1:=Range("A6"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A" & lLastRow + 2).Select
    Range(Selection, "A134").Select
        Selection.EntireRow.Hidden = True
   
    End If
    Else
    MsgBox "Участник уже есть в категории", vbExclamation, "Ошибка"
    Application.ScreenUpdating = True
    End
    End If
    End If
End Sub
Цитата
Hugo написал:
Вот в этих двух строках - ну совершенно по коду не понятно в какой книге берёте эти значения.
Не понял о каких строках идет речь, но везде, где есть какие то ссылки для переменной или данных прописал полный путь.
Изменено: VVS_001 - 28.01.2020 12:34:57
 
Цитата
VVS_001 написал:
как можно решить проблему в случае если это так
- никак. Открывайте в дном приложении.
Цитата
VVS_001 написал:
Не понял о каких строках идет речь, но везде, где есть какие то ссылки для переменной или данных прописал полный путь.
- я говорил о первом коде, где нет номеров строк т.к. он так и не оформлен, а в этой версии это 13 и 14. Но этот код уже сильно другой...
Вообще если ликвидировать все селекты и активации - код будет намного прозрачнее, и может быть его можно будет читать и так с листинга, без наличия файла...
Страницы: 1
Наверх