Платные хостинги     Раскрутка сайта     Книги по программированию

VB для Excel, Сам незнаю как сделать

- Люди есть такой вопрос. Если он даже без ответа не останется, может появяться еще... Я заинтриговал? Нет? Ну кароче , кому как, Может кто-то хочет развлечься, и помочь мне ламеру.Я 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+1WendhighlightSyntax('vbTQyOWE','vb');Ну вот так наверное, да и в свойствах формы ShowModal поствавь False. Так будет удобней работать с формой , она не будет блокировать доступ к самому листу книги

- Нууу, то что листов много, так это просто специфика, там маршрутные листы, сколько маршрутов , столько и листов. Кнопка мне в общем не нужна, т.к. первый лист оочень большой. Мне бы комбинацию клавиш на макрос, но это я и сам могу. Важен сам макрос. Твой не работает. По причине того что листы называются не 1 , 2, 3, а B00 B01 M34 и т.п. Я попробовал немного переделать, хотя куда мне.Код Dim se, sase = 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).ActivatehighlightSyntax('vb3NTllNm','vb'); Вот это как и было у меня раньше, останавливается на 1м листе.Код Dim se, s(50) As String, ns(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 = 1While 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).ActivateIf ActiveCell = TextBox1.Text Then MsgBox "Образец найден"n = n + 1WendhighlightSyntax('vbiZjczN2J','vb'); а вот это пишет Subscript out of range (Error 9), видать я что-то не так сделал. Еще раз скажу в чем идея, идея в том, чтобы при нажатии быстрой клавиши, выскакивало окошко. В которое я вводил номер, и нащимак ok. И оказывался на этом номере, не на первом листе, а на листе того маршрута, в котором этот номер.

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

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

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

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

- Если ты скопировал из vb, мне не понятно как у тебя ищется. Т.к. у меня VB в Excel незнает такого типа Intejer, на integer все нормально стало. Вот код, там я написал где ошибка всегда вылезает.Object variable or With block variable not set (Error 91)Код Dim number As IntegerDim ss As String, sa As Stringss = InputBox(sa) number = 1Application.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 ForNexthighlightSyntax('vbk3MzA0','vb');

- Да у меня что-то в последнее время тяжко с вниманием , но на то есть свои глобальные причины.Конечно нет "Intejer" , а есть "Integer" просто переменные я втыкал тут , а код уже забирал с VBA.Но я опрбывал на книге из 10 листов на кажном листу в среднем 10000 записей , ищет без затыковНу тогда вот так - это по медленней , но зато железобетонно !!!Если не хочешь видеть мильтишение то разремарь Application.ScreenUpdating = FalseКод Private Sub CommandButton1_Click()Dim number As IntegerDim ss As String, sa As Stringss = 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 SubhighlightSyntax('vbTYyODE','vb');

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

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

- Не тут то было =)) , все заработало, сегодня буду проверять.Есть 2 маленьких вопроса.1. У меня есть макрос который ставит дату. вот такой ct = Timecd = DateRange("A1").SelectIf ct > 0 Then ActiveCell.FormulaR1C1 = cdElse ActiveCell.FormulaR1C1 = cd + 1End IfОн должен ставить дату, до 0 следующего дня, а после 0 текущего. Т.е. я могу и руками это делать, но это часть большего макроса. Так вот, дату он ставит не верно, я просто незнаю, как указать время ТОЧНО.2. В макрос который ты предложил, по поиску, надо усовершенствовать, типа должна быть форма с номером, и еще 2мя числами, и они должны забиваться в 2 и 3 ячейки правее. Это обещеное еще в самом начале продолжение. Заранеее очень спасибо... Ты мне уже помог очень...

- Берем форму , втыкаем на нее три TexBox-а и одну кнопку.TexBox1 - Поле для ввода строки поиска ( но можно оставить и инпут , но если ты уже работаешь с формой зачем отвлекатся на дополнительный вылет)TexBox2 и TexBox3 - Поле для ввода строк в ячейки которые находятся правее найденойи так получаем :Код Private Sub CommandButton1_Click()Dim number As IntegerDim ss As String, sa As Stringss = 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  NextIf ActiveCell = ss Then Exit For Next'Application.ScreenUpdating = True 'Разрешение на обновление после выполнения End SubhighlightSyntax('vbwZmVlZ','vb');A вот во втором вопросе по датам и времени , если ты работаешь с реальным временем, т.е. переменная у тебя принимает реальное время ( а у тебя это имеено так ct = Time ) Тогда можно просто принять во внимание , что стандарт времени состоит из от нуля часов 0:00:00 . Тогда ищем первое вхождение символа ":" и если у нас это символ находится на второй позиции !!! тогда время у нас будет только нового дня. Получаем : Код ct = Timecd = DateRange("A1").SelectIf [B]InStr(1, Time, ":", 1) = 2[/B] ThenActiveCell.FormulaR1C1 = cdElseActiveCell.FormulaR1C1 = cd + 1End IfhighlightSyntax('vbViZjg5M','vb');Может есть способ и по оригинальней , пусть меня поправят , но так тоже должно работать !Давай пробуй !! )

- Ну блин ... InStr(1, Time, ":", 1) = 2 только без вот этих и и просто хотел выделить .Эти знаки выкини с кода.Код ct = Timecd = DateRange("A1").SelectIf InStr(1, Time, ":", 1) = 2 ThenActiveCell.FormulaR1C1 = cdElseActiveCell.FormulaR1C1 = cd + 1End IfhighlightSyntax('vb3NzE4Y','vb');Вот так ! )

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

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD