Всем привет. Есть неоднородныйтелефонный справочник, где расписаны сотрудники. Задача - сгруппировать строки в отдельные группы (управлений и дирекций). Слова "дирекция" и "управление" встречаются в разном контексте, поэтому обрабатывать нужно только выделенный диапазон. Алгоритм - два цикла поиска по ключевым словам "дирекция"\ "управление" и группировка содержимого. одно управление - одна группа, и все эти группы потом группируются в дирекции. Макрос выкидывает с ошибкой Run-time error 1004 . Application-defined or object-defined error. Чего не хватает ?
[vba]
Код
Option Explicit Sub grupping() Dim ra As Range, cell As Range Dim pos_dir(100) As Integer Dim pos_upr(500) As Integer Dim i, j As Integer Set ra = Selection
For Each cell In ra.Cells If cell.Value Like "Дирекция" Then pos_dir(cell) = cell.Row End If If cell.Value Like "Управление" Then If pos_upr(cell) < pos_dir(cell) Then pos_upr(cell) = cell.Row End If End If Next cell
i = 1 j = 1 While i < UBound(pos_dir) Range(Cells(pos_dir(i), 1), Cells(pos_dir(i + 1) - 1, 10)).Select Selection.Rows.Group While j < UBound(pos_upr) Range(Cells(pos_upr(j), 1), Cells(pos_upr(j + 1) - 1, 10)).Select Selection.Rows.Group j = j + 1 Wend i = i + 1 Wend End Sub
[/vba]
Всем привет. Есть неоднородныйтелефонный справочник, где расписаны сотрудники. Задача - сгруппировать строки в отдельные группы (управлений и дирекций). Слова "дирекция" и "управление" встречаются в разном контексте, поэтому обрабатывать нужно только выделенный диапазон. Алгоритм - два цикла поиска по ключевым словам "дирекция"\ "управление" и группировка содержимого. одно управление - одна группа, и все эти группы потом группируются в дирекции. Макрос выкидывает с ошибкой Run-time error 1004 . Application-defined or object-defined error. Чего не хватает ?
[vba]
Код
Option Explicit Sub grupping() Dim ra As Range, cell As Range Dim pos_dir(100) As Integer Dim pos_upr(500) As Integer Dim i, j As Integer Set ra = Selection
For Each cell In ra.Cells If cell.Value Like "Дирекция" Then pos_dir(cell) = cell.Row End If If cell.Value Like "Управление" Then If pos_upr(cell) < pos_dir(cell) Then pos_upr(cell) = cell.Row End If End If Next cell
i = 1 j = 1 While i < UBound(pos_dir) Range(Cells(pos_dir(i), 1), Cells(pos_dir(i + 1) - 1, 10)).Select Selection.Rows.Group While j < UBound(pos_upr) Range(Cells(pos_upr(j), 1), Cells(pos_upr(j + 1) - 1, 10)).Select Selection.Rows.Group j = j + 1 Wend i = i + 1 Wend End Sub
Sub test() With ActiveSheet .Outline.SummaryRow = xlAbove lr = .Cells(.Rows.Count, 3).End(xlUp).Row For i = 1 To lr If .Cells(i, 1) Like "Дирекция*" Then .Rows(i).OutlineLevel = 1 ElseIf .Cells(i, 2) Like "Управление*" Then .Rows(i).OutlineLevel = 2 Else .Rows(i).OutlineLevel = 3 End If Next End With End Sub
Sub test() With ActiveSheet .Outline.SummaryRow = xlAbove lr = .Cells(.Rows.Count, 3).End(xlUp).Row For i = 1 To lr If .Cells(i, 1) Like "Дирекция*" Then .Rows(i).OutlineLevel = 1 ElseIf .Cells(i, 2) Like "Управление*" Then .Rows(i).OutlineLevel = 2 Else .Rows(i).OutlineLevel = 3 End If Next End With End Sub
именно, есть и до, и после, там другая структура и слова "управление", "дирекция" встречаются в тех же ячейках, но в другом контексте, что собственно и не нужно группировать.
именно, есть и до, и после, там другая структура и слова "управление", "дирекция" встречаются в тех же ячейках, но в другом контексте, что собственно и не нужно группировать.Trojan_exe