Войти

Показать полную графическую версию : Помогите пожалуйста написать скрипт на VBA


Большой Кол
17-10-2009, 23:59
Доброго времени суток
Имеется задание - из Главного управления приходят акты сверок имеющие, например такой вид(в 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 часов Может подскажите почему не работает?

pva
18-10-2009, 11:09
я сделал запись макроса: найти слово "федеральный округ"

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.

Большой Кол
18-10-2009, 14:58
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 , в чем дело не ясно, может синтаксис не верный, но я уже много вариантов перебрал.

Большой Кол
19-10-2009, 09:46
Воще я правильно синтаксис Like "[Север]*") написал?

Delirium
19-10-2009, 09:58
А почему Север в квадратных скобках? Он и в тексте в таких скобках?

Выведите MsgBox(Range(marcOfString1).Text) программе где нибудь, и сравните его с "[Север]*"

Большой Кол
19-10-2009, 12:41
В квадратных потому что в книге было сказанно, что надо писать в квадратных и такой пример был приведен, хотя это странно

azbest
22-10-2009, 22:49
If (Range(marcOfString1).Text Like "[Север]*") Then Nord Else Ocrug ' если есть северо-запад то Nord если нет то Okrug
If ......... then
Nord
elseif .......then
Okrug
END IF

end sub

:PS
коды округов, районов стоят в одном столбце, отдельно от всех остальных названий? ИХМО Лучше оперировать цифровой кодировкой




© OSzone.net 2001-2012