Добрый день уважаемые форумчане! Возник вопрос - проблема. Есть 2 книги. В одной база с определнными данными. В ячейках B8:B521 стоят номера. С D8 по K521 различные данные (ФИО, возраст и т.п.) Во второй книге небольшая выборка из этой базы. определнные номера и их данные, скопированные из 1 книги. Хочу сделать через InputBox поиск номера, который еще не был ранее скопирован во 2 таблицу. Заранее не знаю, поэтому inputBox и ввожу сам нужный номер. Написал Код. В определнных вкладках 2й книги прописал путь и имя 1 книги (определяю с помощью формул - пстр, найти и различных махинаций с ними). Теперь пытаюсь проверить открыта ли 1 книга или нет, если нет то открываю, а если открыта то сразу приступаю к поиску нужной строки для копирования. Если книга уже была открыта, то проблем нет, все ищется и копируется, а вот если она была закрыта, то поиск не работает. Подскажите, как можно поправить код, чтобы все работало корректно?
Скрытый текст
Sub Макрос1() ' ' Макрос1 Макрос '
' Dim iResult As String iResult = InputBox("Укажите номер участника, который надо добавить", "Введите значение нужного действия!") If iResult = "" Then 'If Len(iResult) = 0 Then MsgBox "Ни одного значения не введено!", vbCritical ElseIf iResult <> 0 Then On Error Resume Next sBookName = Range("Р!J2").Value & ".xls" sBookPath = Range("И!G1").Value Set wBook = Workbooks(sBookName) If wBook Is Nothing Then Workbooks.Open Filename:=sBookPath & sBookName End If Set Gcell = wBook.Sheets("РЕГИСТРАЦИЯ").Range("$B$8:$B$521").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole) If Gcell Is Nothing Then MsgBox "Участник " & iResult & " не найден в регистрации", vbExclamation, "Ошибка" ThisWorkbook.Activate Exit Sub Else Workbooks(Range("Р!J2").Value & ".xls").Activate Sheets("Регистрация").Activate ActiveSheet.Range(Gcell, Gcell.Offset(0, 9)).Copy ThisWorkbook.Activate End If End If End Sub
Обнаружил, что если книга закрыта, то при отсутствии строки On Error Resume Next, ругается на subscript out of range.....
Когда On Error Resume Next стоит, открывается, но поиск выдает, что Gcell = Nothing и уходит из макроса. Доходит до того, что, если я 2 раза подряд запущу макрос, то сперва он откроет книгу и ничего не найдет, а второй раз найдет, потому что книгу открыл в первый раз.
Уважаемые форумчане, оказалось что проблема решена не до конца... Дело в том, что если книга с данными была отркыта до того как я открыл файл с выборкой, то поиск все равно ведет себя неадкватно, и не находит значение. Получается, если я открыл вторую книгу, запустил макрос, а первая была закрыта, все ок. Если после этого я не закрыл первую и еще раз начал поиск, то тоже все ок, Но если сперва была открыта первая, потом я открыл 2, то все заработает только после закрытия первой. Есть ли возможность как это исправить?
Часть кода с поиском выглядит сейчас вот так:
Скрытый текст
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
If wBook Is Nothing Then Set wBook = Workbooks.Open(sBookPath & sBookName) End If
Set GCell = wBook.Sheets("Регистрация").Columns("B:B").Find(What:=iResult, LookIn:=xlValues, LookAt:=xlWhole) If GCell Is Nothing Then MsgBox "Участник " & iResult & " не найден в регистрации", vbExclamation, "Ошибка" ThisWorkbook.Activate -----------
А переменная вынесена вне макроса, и задана как public.
МатросНаЗебре, к сожалению это ничего не изменило. Да наверно и не могло, так как это нужно для открытия книги, или активации, а с этим проблем нет. Проблема как мне кажется в том, что почему то не определяется переменная...но если файл открыт этим же макросом, то переменная определяется..
Убрал строку on error resume next Теперь если 1 книга была ранее открыта пишет object required. Если была закрыта открывает и все норм ищет.
VVS_001 написал: если 1 книга была ранее открыта пишет object required.
- возможно книги открыты в разных экземплярах приложениях. Ну а по оформлению - если код оформлен, то там есть номера строк, и никому их считать не нужно, чтоб указать где возможна ошибка. Вот в этих двух строках - ну совершенно по коду не понятно в какой книге берёте эти значения.
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 написал: как можно решить проблему в случае если это так
- никак. Открывайте в дном приложении.
Цитата
VVS_001 написал: Не понял о каких строках идет речь, но везде, где есть какие то ссылки для переменной или данных прописал полный путь.
- я говорил о первом коде, где нет номеров строк т.к. он так и не оформлен, а в этой версии это 13 и 14. Но этот код уже сильно другой... Вообще если ликвидировать все селекты и активации - код будет намного прозрачнее, и может быть его можно будет читать и так с листинга, без наличия файла...