Люди есть такой вопрос. Если он даже без ответа не останется, может появяться еще... Я заинтриговал? Нет? Ну кароче , кому как, Может кто-то хочет развлечься, и помочь мне ламеру.
Я VB почти не владею, бывает пишу простенькие макросы, т.е. у меня все к этом и сводиться. ЧТобы так сказать облегчить себе работу с Excel. Так вот давно бьюсь надо проблемой, хотя наверно для вас это не проблема, но для меня это просто бревно на скоростной дороге. И даже не одно бревно. Я наверно всех уже утомил, и вы думаете, где собствено вопрос. А вот и он:

У меня есть Excel документ с 54 листами, 49 из которых практически идентичны. На первом листе(он не в ходит в 49), находиться вся информация, это разбитый но зоны лист(естествено только визуально).
Т.е. A1:D10 одна зона E1:I10 Другая, в этих зонах находиться информация, какая это не есть важность. Важно вот что, эта информация из каждой зоны, а их 49, копируется в листы, а на листах просто оформление, этой информации, менять ничего нельзя, т.е. данная структура должна остаться. Нужен макрос который будет искать в 49 листах число(я забыл сказать , что искать надо только число, или как у меня называется это НОМЕР), не забывайте , что на 49 листах просто ссылки. Надо найти и остаться на этом листе на этой ячейке.

Теперь пояснения , как делал я, выделял все 49 листов искал в значениях, но было 2 проблемы, когда это был макрос, искать он останавливался на первом листе(хотя просто поиском все искалось), и вторая, оставалось выделение на всех листах, и информация, которую я добавляю вставлялась во все листы. Вы естествено спросите а почему бы не снять выделение? А я тут же и отвечу. Потому что листов ооочень много, и они не умещаются все на экран. А чтобы его снять, надо ткнуть на не выделеный лист, на который сразу Excel и передет, но мне так не надо.

ТЕперь собтвенно что должен делать макрос(для начала): Он должен выдавать окно , в которое я буду писать номер, и жать ok. И произойдет переход на тот лист в котором этот номер, если при этом еще и на самом номере будет стоять курсор, я буду очень рад, а если он будет стоять , на ячейку правее, просто прыгать от радости, что поверьте мне очень смешно. Сам очень смутно это представляю.

За сим хочу откланяться... Жду отзывов, и вопросов, если они будут...

Вопрос первый : Ты не баишся что у Excel-я башню сорвет в неподходящий момент?
54 листа в книге ??!!! эта круто.
Как-то помню главбух меня все доставала с такой ерундой . Они баланс делали в Excel. Там такая же хрень была ,но только там надо было редактировать ссылки на каждом листе. Там было листов 20 и 6 связанных книг.
А по твоему вопросу я думаю что наверно так:
Сделай форму воткни на нее поле и кнопку.
Поле будет служить шаблоном для поиска, а при нажатии на кнопку работает цикл

Код

While n<> Sheets.Count' n - у тебя зависит с какого листа начинать Sheets(n).Select    Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt:= _    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _     , SearchFormat:=False).Activate If ActiveCell = TextBox1.Text Then MsgBox "Образец найден" n=n+1 Wend

Ну вот так наверное, да и в свойствах формы ShowModal поствавь False. Так будет удобней работать с формой , она не будет блокировать доступ к самому листу книги

Цитата(Alles @ 21.9.2003, 20:00)

Вопрос первый : Ты не баишся что у Excel-я башню сорвет в неподходящий момент? 54 листа в книге ??!!! эта круто. А по твоему вопросу я думаю что наверно так: Сделай форму воткни на нее поле и кнопку. Поле будет служить шаблоном для поиска, а при нажатии на кнопку  работает цикл Код While n<> Sheets.Count' n - у тебя зависит с какого листа начинать Sheets(n).Select    Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt:= _    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _     , SearchFormat:=False).Activate If ActiveCell = TextBox1.Text Then MsgBox "Образец найден" n=n+1 Wend

Нууу, то что листов много, так это просто специфика, там маршрутные листы, сколько маршрутов , столько и листов.

Кнопка мне в общем не нужна, т.к. первый лист оочень большой. Мне бы комбинацию клавиш на макрос, но это я и сам могу. Важен сам макрос. Твой не работает. По причине того что листы называются не 1 , 2, 3, а B00 B01 M34 и т.п. Я попробовал немного переделать, хотя куда мне.

Код

Dim se, sa se = InputBox(sa)    Sheets(Array("В0", "В1", "В2", "В3", "В4", "В5", "В6", "В7", "В8","В9", "В10", "В11", _        "В12", "В13", "В14", "В15", "В16", "В17", "В18", "В19", "В20","В21", "В22", "В23", "В24", _ "М25", "М26", "М27", "М28", "М29", "В30", "В31", "В32", "В33", "В34","B35", _        "B36", "B37", "B38", "B39", "B40", "B41", "B42", "B43", "B44","B45", "B46", "B47", "B48", _        "B49")).Select   Cells.Find(What:=se, After:=ActiveCell, LookIn:=xlValues, LookAt:= _   xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate

Вот это как и было у меня раньше, останавливается на 1м листе.

Код

Dim se, s(50) As String, n s(1) = "B1": s(2) = "B2" s(3) = "B3": s(4) = "B4" s(5) = "B5": s(6) = "B6" s(7) = "B7": s(8) = "B8" s(9) = "B9": s(10) = "B10" n = 1 While n <> Sheets.Count ' n - у тебя зависит с какого листа начинать se = s(n) Sheets(se).Select 'Ошибка вот тут ^^^^^   Cells.Find(What:=TextBox1.Text, After:=ActiveCell, LookIn:=xlValues, LookAt:= _   xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Activate If ActiveCell = TextBox1.Text Then MsgBox "Образец найден" n = n + 1 Wend

а вот это пишет Subscript out of range (Error 9), видать я что-то не так сделал.

Еще раз скажу в чем идея, идея в том, чтобы при нажатии быстрой клавиши, выскакивало окошко. В которое я вводил номер, и нащимак ok. И оказывался на этом номере, не на первом листе, а на листе того маршрута, в котором этот номер.

Привет во первых!
К листу можно обращатся как по имени так и по индексу !"
допустим n - у нас принимает значение 1

Sheets(n).Select ' это выделение листа №1
Sheets("Лист1").Select ' это уже обращаемся к листу по имени

А если у тебя был багг в самом начале цикла то это потому , что нет листа с индексом =0 т.е.
Sheets(0).Select -это ошибка

И еще ! Когда обращаемся к листу по индексу переменная должна быть типа Intejer

Код

Dim number As Intejer Dim ss As String ss = TextBox1.Text ' поле для шаблона поиска Number = 1 Application.FindFormat.NumberFormat = "@" ' текстовый формат For Number = 1 To Sheets.Count ' n - у тебя зависит с какого листа начинать Sheets(Number).Select Cells.Find(What:=ss, After:=ActiveCell, LookIn:=xlFormulas, _        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _        MatchCase:=False).Activate     If ActiveCell = TextBox1.Text Then MsgBox "Образец найден": Exit For Next

Ну вот так у меня ищет все !

Да это я там намудрил и тебе голову заморочил с циклом WHILE WEND . Сам не проверял некагдо было , извени.

Цитата(Alles @ 24.9.2003, 01:08)

Привет во первых! К листу можно обращатся как по имени так и по индексу !"

ДА я как раз извеняться пришел... =)))

Если ты скопировал из vb, мне не понятно как у тебя ищется. Т.к. у меня VB в Excel незнает такого типа Intejer, на integer все нормально стало. Вот код, там я написал где ошибка всегда вылезает.

Object variable or With block variable not set (Error 91)

Код

Dim number As Integer Dim ss As String, sa As String ss = InputBox(sa) number = 1 Application.FindFormat.NumberFormat = "@" For number = 5 To Sheets.Count ' Sheets(number).Select '=================== Cells.Find(What:=ss, After:=ActiveCell, LookIn:=xlFormulas, _       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _       MatchCase:=False).Activate ' вот тут всегда ошибка... '====================    If ActiveCell = ss Then MsgBox "good": Exit For Next

Да у меня что-то в последнее время тяжко с вниманием , но на то есть свои глобальные причины.
Конечно нет "Intejer" , а есть "Integer" просто переменные я втыкал тут , а код уже забирал с VBA.
Но я опрбывал на книге из 10 листов на кажном листу в среднем 10000 записей , ищет без затыков
Ну тогда вот так - это по медленней , но зато железобетонно !!!

Если не хочешь видеть мильтишение то разремарь Application.ScreenUpdating = False

Код

Private Sub CommandButton1_Click() Dim number As Integer Dim ss As String, sa As String ss = InputBox(sa) number = 1 'Application.ScreenUpdating = False 'Запрет на обновление т.е. мильтишение экрана во время обр. For number = 1 To Sheets.Count ' Sheets(number).Select    For columpsearsh = 1 To Sheets(number).Cells.SpecialCells(xlLastCell).Column         For rowsearsh = 1 To Sheets(number).Cells.SpecialCells(xlLastCell).Row               Cells(rowsearsh, columpsearsh).Select            If ActiveCell = ss Then MsgBox "good": Exit For         Next    If ActiveCell = ss Then Exit For   Next If ActiveCell = ss Then Exit For   Next 'Application.ScreenUpdating = True 'Разрешение на обновление после выполнения End Sub

Да еще если после удачного поиска тебе надо что-бы ячейка была правее , тогда просто к найденой ячейке мы прибавляем один столбец. :

Cells(rowsearsh, columpsearsh).Select ' Это найденная ячейка
Cells(rowsearsh, columpsearsh+1).Select ' это сдвиг в право на одну

значит это ты должен воткнуть после условия удачного поиска т.е. вот сюда :
If ActiveCell = ss Then MsgBox "good":Cells(rowsearsh, columpsearsh+1).Select: Exit For

Ну наверно все !!! )) Удачи !

2 alles : скажи мне почему он так не искал, т.е. макрос записываешь, ищет, проигрываешь(ничего не меняя), он ошибку выдает.. Так было на всех компах где я проверял.

Цитата(Alles @ 28.9.2003, 20:34)

Ну наверно все !!! )) Удачи !

Не тут то было =)) , все заработало, сегодня буду проверять.

Есть 2 маленьких вопроса.
1. У меня есть макрос который ставит дату. вот такой
ct = Time
cd = Date
Range("A1").Select
If ct > 0 Then
ActiveCell.FormulaR1C1 = cd
Else
ActiveCell.FormulaR1C1 = cd + 1
End If
Он должен ставить дату, до 0 следующего дня, а после 0 текущего. Т.е. я могу и руками это делать, но это часть большего макроса. Так вот, дату он ставит не верно, я просто незнаю, как указать время ТОЧНО.

2. В макрос который ты предложил, по поиску, надо усовершенствовать, типа должна быть форма с номером, и еще 2мя числами, и они должны забиваться в 2 и 3 ячейки правее. Это обещеное еще в самом начале продолжение.

Заранеее очень спасибо... Ты мне уже помог очень...

Берем форму , втыкаем на нее три TexBox-а и одну кнопку.
TexBox1 - Поле для ввода строки поиска ( но можно оставить и инпут , но если ты уже работаешь с формой зачем отвлекатся на дополнительный вылет)
TexBox2 и TexBox3 - Поле для ввода строк в ячейки которые находятся правее найденой
и так получаем :

Код

Private Sub CommandButton1_Click() Dim number As Integer Dim ss As String, sa As String ss = TexBox1.Text    'InputBox(sa) number = 1 'Application.ScreenUpdating = False 'Запрет на обновление т.е. мильтишение экрана во время обр. For number = 1 To Sheets.Count ' Sheets(number).Select   For columpsearsh = 1 To Sheets(number).Cells.SpecialCells(xlLastCell).Column        For rowsearsh = 1 To Sheets(number).Cells.SpecialCells(xlLastCell).Row              Cells(rowsearsh, columpsearsh).Select  If ActiveCell = ss Then MsgBox "good":Cells(rowsearsh, columpsearsh+1)= TextBox2.Text:Cells(rowsearsh, columpsearsh+2)= TextBox3.Text:Cells(rowsearsh, columpsearsh+1).Select: Exit For        Next   If ActiveCell = ss Then Exit For  Next If ActiveCell = ss Then Exit For Next 'Application.ScreenUpdating = True 'Разрешение на обновление после выполнения End Sub

A вот во втором вопросе по датам и времени , если ты работаешь с реальным временем, т.е. переменная у тебя принимает реальное время ( а у тебя это имеено так ct = Time ) Тогда можно просто принять во внимание , что стандарт времени состоит из от нуля часов 0:00:00 . Тогда ищем первое вхождение символа ":" и если у нас это символ находится на второй позиции !!! тогда время у нас будет только нового дня. Получаем :

Код

ct = Time cd = Date Range("A1").Select If [B]InStr(1, Time, ":", 1) = 2[/B] Then ActiveCell.FormulaR1C1 = cd Else ActiveCell.FormulaR1C1 = cd + 1 End If

Может есть способ и по оригинальней , пусть меня поправят , но так тоже должно работать !
Давай пробуй !! )

Ну блин ... InStr(1, Time, ":", 1) = 2 только без вот этих и и просто хотел выделить .

Эти знаки выкини с кода.

Код

ct = Time cd = Date Range("A1").Select If InStr(1, Time, ":", 1) = 2 Then ActiveCell.FormulaR1C1 = cd Else ActiveCell.FormulaR1C1 = cd + 1 End If

Вот так ! )

) Ну и апять касяк ... )) ну я думаю ты все понял и так ) Парюсь я в этих тегах..... будь они неладны .. ))