|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
27.09.2009, 17:04 | #1 |
Регистрация: 12.09.2009
Сообщений: 8
|
Помогите с циклом!!!!
Здравствуйте форумчане!!!Работаю над программой редактирования рассписания...есть рассписание предметов по дате,дню недели,и номеру пары..смотрите в примере....мне необходимо написать макрос который бы мог копировать нужные шифры на новый лист в шаблон,ориентируясь по дате,паре и дню недели...в принцыпе всё готово...только не получается задать цикл для поиска...
|
27.09.2009, 17:06 | #2 |
Регистрация: 12.09.2009
Сообщений: 8
|
а вот макрос
Sub Raspisanie() Dim iRow As String Dim jk As String Dim VDate As Boolean Search = "*?.??" Inpu = InputBox("Введите шифр дисциплины") MsgBox ("Вы ввели :" & Inpu) Set MyRange = Range("A1:BT213") WWSearch = Inpu Set Srch = MyRange.Find(WWSearch) If Not Srch Is Nothing Then StartCell = Srch.Address Do iRow = Srch.Address Range(StartCell).Offset(-1, 0).Select Vid = ActiveCell.Value Range(StartCell).Offset(1, 0).Select Aud = ActiveCell.Value Range(StartCell).Select ParaNumber = Trim("$B$") & Mid(iRow, (InStr(2, iRow, "$")) + 1) Range(ParaNumber).Select Para = ActiveCell.Value Range(StartCell).EntireRow.Select DenNumber = Trim("$A$") & Mid(iRow, (InStr(2, iRow, "$") + 1)) Range(DenNumber).Select Den = ActiveCell.Value Range(StartCell).Activate Do Until ActiveCell = IsDate(Search) If ActiveCell.Offset(-1, 0) = "" Then ActiveCell.Offset(-1, 0).Activate End If ActiveCell.Offset(-1, 0).Select Set Src = Selection.Find(Search) If IsDate(Src) Then Idat = Src.Address End If Loop Range(Idat).Select Dat = ActiveCell.Value Sheets("K2").Activate Set Srk = Cells.Find(Den) AddressDen = Srk.Address Range(AddressDen).EntireRow.Select Set Srj = Selection.Find(Para) AddressPara = Srj.Address Set Sr = MyRange.Find(Dat, LookAt _ :=xlWhole) AddressData = Sr.Address Mesto = Mid(AddressData, 2, (InStr(2, AddressData, "$")) - 2) & Mid(AddressPara, (InStr(2, AddressPara, "$")) + 1) Range(Mesto).Select ActiveCell.FormulaR1C1 = Vid Range(Mesto).Offset(1, 0).Select ActiveCell.FormulaR1C1 = Inpu Range(Mesto).Offset(2, 0).Select ActiveCell.FormulaR1C1 = Aud Set Srch = MyRange.FindNext(Srch) Loop While Not Srch Is Nothing And Srch.Address <> StartCell End If End Sub Sub TsiklPoiska() Dim iRow As String Dim Inpu As String Inpu = InputBox("Введите шифр дисциплины") MsgBox ("Вы ввели :" & Inpu) Set MyRange = Range("D11:AW22") WWSearch = Inpu Set Srch = MyRange.Find(WWSearch) If Not Srch Is Nothing Then StartCell = Srch.Address Do iRow = Srch.Address Range(StartCell).Select Den = ActiveCell.Value Sheets("K2").Select Range(StartCell).Select ActiveCell.FormulaR1C1 = Den Set Srch = MyRange.FindNext(Srch) Loop While Not Srch Is Nothing And Srch.Address <> StartCell End If End Sub |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
помогите с циклом | pobedin | БД в Delphi | 2 | 28.08.2009 14:56 |
Помогите с циклом | BuT@JL | Помощь студентам | 3 | 25.03.2009 17:53 |
помогите с циклом | Lonix | PHP | 1 | 19.09.2008 17:51 |
Помогите с циклом | Almost_Famous | Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM | 8 | 27.03.2008 21:08 |