Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > VB6 > VB для Excel

Автор: iNot 20.9.2003, 21:31

Люди есть такой вопрос. Если он даже без ответа не останется, может появяться еще... Я заинтриговал? Нет? Ну кароче , кому как, Может кто-то хочет развлечься, и помочь мне ламеру. Я VB почти не владею, бывает пишу простенькие макросы, т.е. у меня все к этом и сводиться. ЧТобы так сказать облегчить себе работу с Excel. Так вот давно бьюсь надо проблемой, хотя наверно для вас это не проблема, но для меня это просто бревно на скоростной дороге. И даже не одно бревно. Я наверно всех уже утомил, и вы думаете, где собствено вопрос. А вот и он: У меня есть Excel документ с 54 листами, 49 из которых практически идентичны. На первом листе(он не в ходит в 49), находиться вся информация, это разбитый но зоны лист(естествено только визуально). Т.е. A1:D10 одна зона E1:I10 Другая, в этих зонах находиться информация, какая это не есть важность. Важно вот что, эта информация из каждой зоны, а их 49, копируется в листы, а на листах просто оформление, этой информации, менять ничего нельзя, т.е. данная структура должна остаться. Нужен макрос который будет искать в 49 листах число(я забыл сказать , что искать надо только число, или как у меня называется это НОМЕР), не забывайте , что на 49 листах просто ссылки. Надо найти и остаться на этом листе на этой ячейке. Теперь пояснения , как делал я, выделял все 49 листов искал в значениях, но было 2 проблемы, когда это был макрос, искать он останавливался на первом листе(хотя просто поиском все искалось), и вторая, оставалось выделение на всех листах, и информация, которую я добавляю вставлялась во все листы. Вы естествено спросите а почему бы не снять выделение? А я тут же и отвечу. Потому что листов ооочень много, и они не умещаются все на экран. А чтобы его снять, надо ткнуть на не выделеный лист, на который сразу Excel и передет, но мне так не надо. ТЕперь собтвенно что должен делать макрос(для начала): Он должен выдавать окно , в которое я буду писать номер, и жать ok. И произойдет переход на тот лист в котором этот номер, если при этом еще и на самом номере будет стоять курсор, я буду очень рад, а если он будет стоять , на ячейку правее, просто прыгать от радости, что поверьте мне очень смешно. Сам очень смутно это представляю. За сим хочу откланяться... Жду отзывов, и вопросов, если они будут...

Автор: Alles 21.9.2003, 20:00

Вопрос первый : Ты не баишся что у 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. Так будет удобней работать с формой , она не будет блокировать доступ к самому листу книги

Автор: iNot 23.9.2003, 14:43

Цитата(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. И оказывался на этом номере, не на первом листе, а на листе того маршрута, в котором этот номер.

Автор: Alles 24.9.2003, 01:08

Привет во первых! К листу можно обращатся как по имени так и по индексу !" допустим n - у нас принимает значение 1 Sheets(n).Select ' это выделение листа №1 Sheets("Лист1").Select ' это уже обращаемся к листу по имени А если у тебя был багг в самом начале цикла то это потому , что нет листа с индексом =0 т.е. Sheets(0).Select -это ошибка И еще ! Когда обращаемся к листу по индексу переменная должна быть типа Intejer

Автор: Alles 24.9.2003, 04:41

Код 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 Ну вот так у меня ищет все !

Автор: Alles 24.9.2003, 04:55

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

Автор: iNot 26.9.2003, 06:49

Цитата(Alles @ 24.9.2003, 01:08) Привет во первых! К листу можно обращатся как по имени так и по индексу !" ДА я как раз извеняться пришел... =)))

Автор: iNot 26.9.2003, 16:43

Если ты скопировал из 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

Автор: Alles 28.9.2003, 20:26

Да у меня что-то в последнее время тяжко с вниманием , но на то есть свои глобальные причины. Конечно нет "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

Автор: Alles 28.9.2003, 20:34

Да еще если после удачного поиска тебе надо что-бы ячейка была правее , тогда просто к найденой ячейке мы прибавляем один столбец. : Cells(rowsearsh, columpsearsh).Select ' Это найденная ячейка Cells(rowsearsh, columpsearsh+1).Select ' это сдвиг в право на одну значит это ты должен воткнуть после условия удачного поиска т.е. вот сюда : If ActiveCell = ss Then MsgBox "good":Cells(rowsearsh, columpsearsh+1).Select: Exit For Ну наверно все !!! )) Удачи !

Автор: iNot 29.9.2003, 14:16

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

Автор: iNot 29.9.2003, 14:18

Цитата(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 ячейки правее. Это обещеное еще в самом начале продолжение. Заранеее очень спасибо... Ты мне уже помог очень...

Автор: Alles 30.9.2003, 04:57

Берем форму , втыкаем на нее три 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 Может есть способ и по оригинальней , пусть меня поправят , но так тоже должно работать ! Давай пробуй !! )

Автор: Alles 30.9.2003, 05:13

Ну блин ... 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 Вот так ! )

Автор: Alles 30.9.2003, 05:47

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

Автор: iNot 30.9.2003, 20:11

Цитата(Alles @ 30.9.2003, 05:47) ) Ну и апять касяк ... )) ну я думаю ты все понял и так ) Парюсь я в этих тегах..... будь они неладны .. )) Я попробую, я просто InStr первый раз вижу... Хедпу там почитаю, сеня вечером буду думать....

Автор: Alles 5.10.2003, 05:17

Как ты там ? есть результаты ?? или опять не работает ?

Автор: iNot 5.10.2003, 08:02

Цитата(Alles @ 5.10.2003, 05:17) Как ты там ? есть результаты ?? или опять не работает ? оооо все работает. Я немнго его усовершенствовал, а то правда долго искалось(цисла в одной колонке были, я просто for 1 убрал ). Форму сделал.. Сейчас я просто пол недели не работаю, поэтому воросов пока нет....

Автор: Alles 5.10.2003, 21:07

Тебе сам код понятен? Может объяснить поэтапно ? Для динамики поиска в начало цикла : For number = 1 To Sheets.Count вместо 1 лучше воткнуть значения поля. Поставь на форму дополнительное поле (TextBox) и сливай в цикл номер листа с которого нужно начинать поиск, получится: For number = TextBox4.Text To Sheets.Count А если немного усложнить и вместо поля добавить список то стартовый лист можно выбирать из списка , и сделать ограничение по поиску поставив CheckBox1(флажек) если флажек активный тогда ищем все записи если нет тогда выходим с процедуры поиска на первой найденной. Код Private Sub UserForm_Activate() ' Заполнение списка именами листов For n = 1 To Sheets.Count Sheets(n).Select ListBox1.AddItem Sheets(n).Name Next Sheets(1).Select End Sub Private Sub ListBox1_Click() Dim fff  As String 'Sheets(ListBox1.ListIndex + 1).Select ' 'Установка стартового листа по идексу fff = ListBox1 Sheets(fff).Select 'Установка стартового листа по имени End Sub Private Sub CommandButton1_Click() Dim number As Integer, rrr   As Integer Dim ss As String, sa As String ss = TextBox1    'InputBox(sa) rrr = ActiveSheet.Index 'Application.ScreenUpdating = False For number = rrr 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 _ : If CheckBox1.Value = True Then Exit For Else Exit Sub ' если CheckBox1 активный тогда ' ищем все записи иначе выход на первой удачной               Next  If ActiveCell = ss Then Exit For Next If ActiveCell = ss Then Exit For Next 'Application.ScreenUpdating = True End Sub

Автор: iNot 8.10.2003, 13:38

Цитата(Alles @ 5.10.2003, 21:07) Тебе сам код понятен? Может объяснить поэтапно ? Для динамики поиска в начало цикла : For number = 1 To Sheets.Count вместо 1 лучше воткнуть значения поля. Поставь на форму дополнительное поле (TextBox) и сливай в цикл номер листа с которого нужно начинать поиск, получится: For number = TextBox4.Text To Sheets.Count Мне в общем все понятно. Я там немного переделал, форму сделал, и поиск зъузил, а то долго искалось. Все отлично сейчас. Есть еще пара идей... Может мы в Асю передем, или в мыло? =))

Автор: Alles 8.10.2003, 18:59

Нет проблем !!! стучи в Асю 45033230

Автор: cardinal 8.10.2003, 22:38

Alles, ты довольно полезные вещи пишешь на мой взгляд, но чтобы их для других поместить в FAQ я должен как-то назвать тему. Ты мне мыль, пожалуйста, если написал что-то стоящее и заголовок какой нибудь напиши типа: "Как ... ?", ну вообщем как в FAQ`e, а я засуну это в FAQ. Цитата Может мы в Асю передем, или в мыло? =)) Лучше начните новую тему под каким нибудь названием того, что вы в данный момент обсуждаете ("Как подвесить компер при помощи Excel?" например), тогда и другие смогут помозговать над вашими проблемами.

Автор: Alles 9.10.2003, 01:40

cardinal ) .......... Ок

Автор: iNot 9.10.2003, 10:04

Цитата(cardinal @ 8.10.2003, 22:38) Alles, ты довольно полезные вещи пишешь на мой взгляд, но чтобы их для других поместить в FAQ я должен как-то назвать тему. Ты мне мыль, пожалуйста, если написал что-то стоящее и заголовок какой нибудь напиши типа: "Как ... ?", ну вообщем как в FAQ`e, а я засуну это в FAQ. Лучше начните новую тему под каким нибудь названием того, что вы в данный момент обсуждаете ("Как подвесить компер при помощи Excel?" например), тогда и другие смогут помозговать над вашими проблемами. Фишка не в том , что мне жалко, что кто-то это еще увидит, а в том, что так прсто быстрее... =)

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)