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