|
Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » VBA - Помогите пожалуйста написать скрипт на VBA |
|
VBA - Помогите пожалуйста написать скрипт на VBA
|
Пользователь Сообщения: 57 |
Доброго времени суток
Имеется задание - из Главного управления приходят акты сверок имеющие, например такой вид(в Excel) Центральный федеральный округ первый район 5354 второй район 546546 третий район 56 четвертый 6588 пятый район 565 Северо-западный федеральный округ первый район 54546 второй район 456 третий район 45 первый федеральный округ первый район 456 второй район 8687 третий район 546 четвертый 546546 пятый район 54654 шестой район 54654 седьмой район 456 восьмой район 56565 девятый район 88 десятый район 546 одинадцатый 5464 второй федеральный округ первый район 564 второй район 5654 третий район 56548 четвертый 887 третий федеральный округ первый район 6544 второй район 987 третий район 879 четвертый район 789 пятый район 8787 шестой район 78987 седьмой район 78987 восьмой район 879 Необходимо написать скрипт который бы удалял все что не относится к Северо-западному округу. Опасаясь жесткой анальной пенитрации, я начал учить VBA (сегодня в 11-00) и вот что у меня радилось на данный момент: Public numberOfBeginString As Integer 'номер первой удаляемой строки Public numberOfCalcString As Integer ' вычичсляет место с которого проводить проверки для удаления Public lastNumberOfString As Integer ' номер последней удаляемой строки Public newMarcOfString As String ' имя диопазона ячеек для удаления Public ciklForOcrug As Integer ' переменная цикла для Ocrug Public marcOfString1 As String ' используется для вычисления имени ячейки в которой проверяется наличие ОКРУГ Public marcOfString2 As String ' используется для вычисления имени ячейки в которой проверяется наличие ОКРУГ и СЕВЕР Public marcOfString3 As String ' используется для вычисления имени ячейки в которой проверяется наличие ОКРУГ в цикле ciklForOcrug Sub Макрос3() numberOfBeginString = 1 ' первоначальные значения присвоены numberOfCalcString = 1 lastNumberOfString = 1 newMarcOfString = "1:1" marcOfString1 = "A1" marcOfString2 = "A1" ciklForOcrug = 2 marcOfString3 = "A1" For numberOfBeginString = numberOfCalcString To 1000 ' начинает поиск слова округ во всей таблице(не в книге) с начала, а потом с того места где не удалять marcOfString1 = "A" & numberOfBeginString ' вычисление имени ячейки для проверки на наличие округ If Range(marcOfString1).Text Like "*[округ]" Then Proverka ' если округ найден то тогда проверим есть ли там Северо-Запад Next ' снова ищем округ, но с позиции numberOfCalcString End Sub Private Sub Nord() ' выполняем если там слово север For numberOfCalcString = 1 To 1000 ' если найдено начинается цикл ищущий следующее слово округ marcOfString2 = "A" & numberOfCalcString 'вычисление имени для проверки на наличие округ If Range(marcOfString2).Text Like "*[округ]" Then Exit For ' если найдено то завершаем цикл, в переменной numberOfCalcString запомнилось место где округ Next numberOfCalcString MsgBox (numberOfBeginString) ' пишем имя следующего за СЕВЕР значения ОКРУГ End Sub Private Sub Proverka() ' проверяем есть ли рядом с округом слово северо запад If (Range(marcOfString1).Text Like "[Север]*") Then Nord Else Ocrug ' если есть северо-запад то Nord если нет то Okrug ' если в этой же ячейке содержится север то ..... ' иначе , т.е. если не найден одновременно округ и север.... End Sub Private Sub Ocrug() ' выполняем если округ For ciklForOcrug = 2 To 100 marcOfString3 = "A" & ciklForOcrug ' вычисление имени ячейки для проверки на наличие округ, следующее значение If Range(marcOfString3).Text Like "*[округ]" Then Exit For ' вычисляем последнюю удаляемую строку Next lastNumberOfString = ciklForOcrug - 1: newMarcOfString = "1" & ":" & lastNumberOfString ' вычисляется имя диопазона для удаления MsgBox (newMarcOfString) ' имя диапозона Rows(newMarcOfString).Delete Shift:=xlUp numberOfBeginString = 1 End Sub Алгоритм такой - цикл проверяет строки на присутствие в них надписи - округ, если находит то начинает проверку есть ли там слово север, если не находит то стрирает все от найденой строки(там где есть есть округ) до следующей строки где найдено слово округ. Если слово север найдено, то от этой строки ищется слово округ, и от его позиции начинает по новой отрабатываться первоначальный цикл. Помоему загвоздка в процедуре Private Sub Proverka() ' проверяем есть ли рядом с округом слово северо запад If (Range(marcOfString1).Text Like "[Север]*") Then Nord Else Ocrug ' если есть северо-запад то Nord если нет то Okrug ' если в этой же ячейке содержится север то ..... ' иначе , т.е. если не найден одновременно округ и север.... End Sub сдесь не срабатывает переход к процедуре Nord , но я не соображу почему. Да и вобще возможно весь скрипт кривой-косой. Не соображу так как изучаю VBA всего 13 часов Может подскажите почему не работает? |
|
Отправлено: 23:59, 17-10-2009 |
![]() Ветеран Сообщения: 1180
|
Профиль | Отправить PM | Цитировать я сделал запись макроса: найти слово "федеральный округ"
Cells.Find(What:="федеральный округ", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False).Activate 1. найти слово "северо-западный федеральный округ", запомнить begin 2. найти слово "федеральный округ" (после него), запомнить end 3. скопировать диапазон begin-end в новую книгу. Как именно это делается, можно узнать, проделав это вручную в режиме записи макроса, потом заменить вписанные автоматически константы переменными begin, end. |
Отправлено: 11:09, 18-10-2009 | #2 |
Для отключения данного рекламного блока вам необходимо зарегистрироваться или войти с учетной записью социальной сети. Если же вы забыли свой пароль на форуме, то воспользуйтесь данной ссылкой для восстановления пароля. |
Пользователь Сообщения: 57
|
Профиль | Отправить PM | Цитировать pva, спасибо идея интерестная. Но дело в том что в книге песколько таких листов и каждый раз колличество разное. Хотя черт его знает, попробывать можно
с утра перепроверил скрипт, немного переписал. Но загвоздка именно в строке Private Sub Proverka() ' проверяем есть ли рядом с округом слово северо запад If (Range(marcOfString1).Text Like "[Север]*") Then Nord Else Ocrug ' если есть северо-запад то Nord если нет то Okrug ' если в этой же ячейке содержится север то ..... ' иначе , т.е. если не найден одновременно округ и север.... End Sub а конкретно, If (Range(marcOfString1).Text Like "[Север]*") Then Nord сдесь не перехдит в Nord , в чем дело не ясно, может синтаксис не верный, но я уже много вариантов перебрал. |
Отправлено: 14:58, 18-10-2009 | #3 |
Пользователь Сообщения: 57
|
Профиль | Отправить PM | Цитировать Воще я правильно синтаксис Like "[Север]*") написал?
|
Отправлено: 09:46, 19-10-2009 | #4 |
Ветеран Сообщения: 5624
|
Профиль | Отправить PM | Цитировать А почему Север в квадратных скобках? Он и в тексте в таких скобках?
Выведите MsgBox(Range(marcOfString1).Text) программе где нибудь, и сравните его с "[Север]*" |
|
------- Отправлено: 09:58, 19-10-2009 | #5 |
Пользователь Сообщения: 57
|
Профиль | Отправить PM | Цитировать В квадратных потому что в книге было сказанно, что надо писать в квадратных и такой пример был приведен, хотя это странно
|
Отправлено: 12:41, 19-10-2009 | #6 |
Старожил Сообщения: 369
|
Профиль | Отправить PM | Цитировать Цитата:
Nord elseif .......then Okrug END IF end sub :PS коды округов, районов стоят в одном столбце, отдельно от всех остальных названий? ИХМО Лучше оперировать цифровой кодировкой |
|
Последний раз редактировалось azbest, 22-10-2009 в 23:02. Отправлено: 22:49, 22-10-2009 | #7 |
![]() |
Участник сейчас на форуме |
![]() |
Участник вне форума |
![]() |
Автор темы |
![]() |
Сообщение прикреплено |
| |||||
Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
VBA - *VBA* | Помогите написать макросы для Excel'я | ove | Программирование и базы данных | 76 | 24-08-2010 16:24 | |
FreeBSD - Помогите написать скрипт | Stirs | Общий по FreeBSD | 2 | 25-06-2008 02:29 | |
Помогите написать небольшой скрипт | rusGT | Программирование в *nix | 3 | 04-05-2008 22:40 | |
Помогите написать скрипт копирования | Filariel | Программирование в *nix | 7 | 17-11-2006 16:38 | |
Помогите написать скрипт!!! | Sergei Antoshkin | Вебмастеру | 1 | 13-03-2003 18:22 |
|