Знатокам VBA

← →
SerJaNT © (2007-08-06 05:09) [0]

Встала задача написать скрипт на VBA, но столкнулся с проблемой((

В документе Excel на листе "Лист1" находится такой текст:

@
Заголовок1
Документ1 bla bla bla
Документ2 bla bla bla
@
Заголовок2
Документ1 bla bla bla
Документ2 bla bla bla
@
Заголовок3
Документ1 bla bla bla
Документ2 bla bla bla
Документ3 bla bla bla
Документ4 bla bla bla
Изображение1 bla bla bla
Изображение2 bla bla bla
@

Задача состоит в следующем:
необходимо сгруппировать строки после ЗаголовокN и до первого символа @ т.е. строки где встречаются слова "Документ" и "Изображение".
Написал такой скрипт:

(Перед выполнением необходимо выделить ВСЕ строки с данными)

Sub Группировка() Dim I, J, StartBlockIndex, EndBlockIndex As Integer Dim CurrCellText As String StartBlockIndex = 3 EndBlockIndex = 1 " кол-во выделенных строк J = Selection.Rows.Count For I = 1 To J Step 1 " получаем текст в текущей ячейке CurrCellText = Worksheets("Лист1").Cells(I, 1).Value If CurrCellText = "" Then Exit For " определяем номер строки с которой начинаем группировку If CurrCellText = "@" Then StartBlockIndex = I + 2 End If " определяем номер последней строки блока для группировки If (InStr(CurrCellText, "Юнита") <> 0) Or (InStr(CurrCellText, "Модуль") <> 0) Then EndBlockIndex = I Else Worksheets("Лист1").Rows(StartBlockIndex & ":" & EndBlockIndex).Select " группируем выделенные строки Selection.Rows.Group End If Next I End Sub

После выполнения получается такое... Никогда на vba не писал, уже третий день пытаюсь...
Помогите, пожалуйста найти где ошибка в моем макросе.

← →
МихаилМ (2007-08-06 09:40) [1]

Ошибка в том, что вопрос на этом языке стоит задавать на сайте SQL.RU :)

← →
AZIZE © (2007-08-06 09:52) [2]

> Никогда на vba не писал

и правильно делал

← →
umbra © (2007-08-06 11:28) [3]

> В документе Excel на листе "Лист1" находится такой текст:
>
>

всегда в одном и том же месте?

вот, правла не тестировал :)
Dim firstcell as Range, mycell as range, myrange as range, prevrow as integer set firstcell = thisWorkbook.Worksheets("Лист1").Cells.Find What:="@", LookIn:=xlValues, LookAt:=xlRows if not firstcell is Nothing then Set Myrange = thisWorkbook.Worksheets("Лист1").Cells.Columns(firstcell.Column) set mycell = firstcell prevrow = mycell.Row Set MyCell = myrange.Find What:="@", LookIn:=xlValues, LookAt:=xlRows if not mycell is Nothing then do with myrange .Range(.Cells(prevrow + 1, 1), .Cells(mycell.Row - 1, 1).Group prevrow = mycell.Row Set MyCell = FindNext After:=mycell end with loop until mycell is Nothing or mycell.Row = firstcell.Row end if end if

Знатокам VBA Найти похожие ветки