Здравствуйте.
Ломаю голову над проблемой, мне необходимо сделать многоуровневую автоматическую группировку между найденными значениями, так же чтобы можно было работать с найденными диапазонами.
Пробовал через метод .find, работает, но только с одним уровнем. Если искать внутри одного уровня другие значения, то код ведет себя неадекватно и зацикливается.
Хотел через массивы, но не дошло до меня как именно сделать.
Уровней группировки может быть любое до 10.
Группировка происходит по столбцу ключ по принципу
1 уровень: от "сборка" до "сборка" или до" Конец сборка" или до "отд деталь" или до конца таблицы
2 уровень: от "подсборка" до "подсборка" или до "конец подсборка" или до "конец подсборка N уровень" или до "сборка" или до "отд деталь" или до конца выше уровня
3 уровень от "подсборка 2 уровня" до по аналогии с предыдущим
Подскажите, пожалуйста, пути решения.
Вот этим кодом смог 1 уровень сделать, дальше - глухо.
Ломаю голову над проблемой, мне необходимо сделать многоуровневую автоматическую группировку между найденными значениями, так же чтобы можно было работать с найденными диапазонами.
Пробовал через метод .find, работает, но только с одним уровнем. Если искать внутри одного уровня другие значения, то код ведет себя неадекватно и зацикливается.
Хотел через массивы, но не дошло до меня как именно сделать.
Уровней группировки может быть любое до 10.
Группировка происходит по столбцу ключ по принципу
1 уровень: от "сборка" до "сборка" или до" Конец сборка" или до "отд деталь" или до конца таблицы
2 уровень: от "подсборка" до "подсборка" или до "конец подсборка" или до "конец подсборка N уровень" или до "сборка" или до "отд деталь" или до конца выше уровня
3 уровень от "подсборка 2 уровня" до по аналогии с предыдущим
Подскажите, пожалуйста, пути решения.
Вот этим кодом смог 1 уровень сделать, дальше - глухо.
| Код |
|---|
Sub сделатьсборки()
'On Error Resume Next
Set spec = ActiveWorkbook.Sheets("Заказ").ListObjects("Спец")
firstrowtb = spec.HeaderRowRange.Row
lastrowtb = spec.HeaderRowRange.Row + spec.DataBodyRange.Rows.Count
'ActiveWorkbook.Sheets("Заказ").Rows("16:" & lastrowtb).Ungroup
With spec.DataBodyRange.Columns("G")
Set s = .Find("Сборка", lookat:=xlWhole)
If Not s Is Nothing Then
firstsborka = s.Row
Do
sborka1 = s.Row
Set s = .FindNext(s)
sborka2 = s.Row
If sborka2 = firstsborka Then sborka2 = lastrowtb + 1
ActiveWorkbook.Sheets("Заказ").Rows(sborka1 + 1 & ":" & sborka2 - 1).Group
Loop While s.Row <> firstsborka
End If
End With
End Sub
|
Изменено: - 30.11.2020 15:20:23
