Макрос. Поиск начала и конца нескольких диапазонов

@Archi992 · Регистрация: 08.10.2019

Студворк — интернет-сервис помощи студентам

Добрый день!

Помогите, пожалуйста, кто разбирается с макросами.
Есть необходимость создания формы, где перед пользователем, при выборе значения из выпадающего списка, должны открываться соотвествующее число диапазонов. Например при выборе значения "2", будут раскрываться во всех пунктах по два подпункта.

Проблема в том, что при добавлении строк, рэнджи на которые ссылается макрос, съезжают.

Вопрос: как можно прописать макрос, чтобы либо не съезжали рэнджи (по аналогии как работает "А$1$:C$1$"), либо осуществлялся поиск начала и конца рэнджа по уникальному значению.

Количество рэнджей будет около 300, количество редактируемых ячеек с выпадающим списком около 50.
возможно кто-то еще знает как упростить макрос.

Буду очень благодарен за Ваши советы и решения!

Ниже представлен мой код, а также прикреплен сам файл excel:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
Public Sub MACRO1()
Dim i, p, m, l, n, k, b, h, t, q, ia, pa, ma, la, na, ka, ba, ha, ta, qa As Range
 
Set i = Range("A3", "A12") 'все
Set p = Range("A5", "A12") '1
Set m = Range("A6", "A12") '2
Set l = Range("A7", "A12") '3
Set n = Range("A8", "A12") '4
Set k = Range("A9", "A12") '5
Set b = Range("A10", "A12") '6
Set h = Range("a11", "A12") '7
Set t = Range("A12", "A12") '8
Set q = Range("A3", "A12") '9
 
Set ia = Range("a17", "a26") 'все
Set pa = Range("a19", "a26") '1
Set ma = Range("a20", "a26") '2
Set la = Range("A21", "A26") '3
Set na = Range("A22", "A26") '4
Set ka = Range("A23", "A26") '5
Set ba = Range("A24", "A26") '6
Set ha = Range("a25", "A26") '7
Set ta = Range("A26", "A26") '8
Set qa = Range("A17", "A26") '9
 
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
'все
If [J2] = 0 Then
        i.Select
        Selection.EntireRow.Hidden = True
        ia.Select
        Selection.EntireRow.Hidden = True
     Else
'1
If [J2] = 1 Then
         i.Select
         Selection.EntireRow.Hidden = False
         p.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         pa.Select
         Selection.EntireRow.Hidden = True
     Else
'2
If [J2] = 2 Then
         i.Select
         Selection.EntireRow.Hidden = False
         m.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         ma.Select
         Selection.EntireRow.Hidden = True
    Else
'3
If [J2] = 3 Then
         i.Select
         Selection.EntireRow.Hidden = False
         l.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         la.Select
         Selection.EntireRow.Hidden = True
    Else
'4
If [J2] = 4 Then
         i.Select
         Selection.EntireRow.Hidden = False
         n.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         na.Select
         Selection.EntireRow.Hidden = True
    Else
'5
If [J2] = 5 Then
         i.Select
         Selection.EntireRow.Hidden = False
         k.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         ka.Select
         Selection.EntireRow.Hidden = True
    Else
'6
If [J2] = 6 Then
        i.Select
         Selection.EntireRow.Hidden = False
         b.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         ba.Select
         Selection.EntireRow.Hidden = True
    Else
'7
If [J2] = 7 Then
         i.Select
         Selection.EntireRow.Hidden = False
         h.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         ha.Select
         Selection.EntireRow.Hidden = True
    Else
'8
If [J2] = 8 Then
         i.Select
         Selection.EntireRow.Hidden = False
         t.Select
         Selection.EntireRow.Hidden = True
         
         ia.Select
         Selection.EntireRow.Hidden = False
         ta.Select
         Selection.EntireRow.Hidden = True
    Else
' 9
If [J2] = 9 Then
         q.Select
         Selection.EntireRow.Hidden = False
         
         qa.Select
         Selection.EntireRow.Hidden = False
    
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
 
Range("J2").Select
 
Application.EnableEvents = True
Application.ScreenUpdating = True
 
End Sub

@АЕ · 15.10.2019, 14:31

Archi992, я раза 4 перечитал задачку.... Не пойму для чего штаны через голову надевать...
Ну съезжать ничего не будет если массивы располагать горизонтально а вертикально.
Как должна выглядеть форма? Вы бы ее нарисовали. Понять было бы проще понять что вам требуется.
В VBA эксэль ничего не адаптировал и похоже не будет. Для этого используют относительные ссылки
типа Cells(1, 1).CurrentRegion.Rows.Count

@Archi992 · 15.10.2019, 15:34 **[ТС]**

"Ну съезжать ничего не будет если массивы располагать горизонтально а вертикально." - это как?

Форму я прикладывал к теме, прикреплю еще раз.
Попробую разъяснить суть задачки, может я действительно не с той стороны подошел к вопросу.
У меня есть форма отчета, в которой очень много пунктов и количество подпунктов в них зависит от определенного значения.
Например, у есть пункт "Кол-во этапов строительства", где пользователю предлагается выбрать соответствующую цифру из выпадающего списка.
Далее, если допустим было выбрано "5", то в следующих пунктах должны развернуться по 5 подпунктов для заполнения.
В некоторых пунктах есть значение "не требуется" и тогда содержимое этого пункта полностью сворачивается.

Также в модуле листа прописан код, чтобы запускался макрос при редактировании определенной ячейки.
Прописав соответствующие коды я смог добиться корректной работы макроса, но осталась проблема с добавлением\удалением строк. Рэнджи макроса съезжают.

@Archi992 · 15.10.2019, 15:39 **[ТС]**

прикрепляю файл.

Макрос 1 - это изначально поставленный под вопрос макрос.

Макрос 2 - это уже доработанный макрос, с использованием именованных ячеек. Но тут проблема в том, что модель листа ссылается на ячейку, которая запускает макрос... оно так и должно работать по задумке.. но ячейка активирует макрос только при непосредственном ее редактировании. Как сделать так, чтобы макрос запускался именно при любом изменении ячейки:

Private Sub Worksheet_Change(ByVal cc As Range)
If cc.Address = "$J$2" Then
Call MACRO1
End If
End Sub

@Narimanych · 15.10.2019, 15:42

Archi992,

попробуйте для вашего файла

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub MMM()
Application.ScreenUpdating = False
For i = 2000 To 3 Step -1
If Cells(i, 1).Value = 0 Then Rows(i).Delete
Next
 
 
 
For i = 1 To 2000
If Cells(i, 1).Value <> 0 Then
For x = 1 To Range("J2").Value
Rows(i + x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + x, 2).Value = x
Cells(i + x, 3).Value = "a"
Next
End If
Next
Application.ScreenUpdating = True
End Sub

@Archi992 · 15.10.2019, 15:58 **[ТС]**

Возможно кто-то подскажет как еще возможно выполнить поставленную задачу или упростить\усовершенствовать имеющийся подход.
Буду очень благодарен за помощь и советы

Добавлено через 14 минут
Narimanych, а можете пояснить что делает этот код?
Как для чайника, пожалуйста

@Narimanych · 15.10.2019, 16:15

Сообщение от Archi992

делает этот код

стирает строки , с 2000 и наверх до 3-ей, если значения в столбце А равны 0

Visual Basic
1
2
3
For i = 2000 To 3 Step -1
If Cells(i, 1).Value = 0 Then Rows(i).Delete
Next

Visual Basic
1
2
3
4
5
6
7
8
9
For i = 1 To 2000
If Cells(i, 1).Value <> 0 Then 'если значение в ячейке столбца А не равно 0 то 
For x = 1 To Range("J2").Value  'циклом от 1го до Значения , указанного в ячейке J2 вставить строки ,...
Rows(i + x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i + x, 2).Value = x
Cells(i + x, 3).Value = "a"
Next
End If
Next

@АЕ · 15.10.2019, 16:19

Сообщение от Archi992

Форму я прикладывал к теме, прикреплю еще раз.

Еще раз приложенной формы в модуле с кодом не обнаружил.
Что вы формой называете? Может мы говорим на разных языках?

@Archi992 · 15.10.2019, 16:59 **[ТС]**

АЕ, смотрите внимательней выше.
Прикреплен ZIP архив.

@АЕ · 15.10.2019, 17:08

Archi992,

Сообщение от Archi992

Прикреплен ZIP архив.

Внимательно изучил архив. Ни в одном из двух файлов не нашел форм. Только модули с вашим заунывным кодом.
можно написать так: 24*12 = 298
а можно так 24+24+24+24+24 и так 12 раз......
При расположении в ряд ваших таблиц, а не в столбик (я писал об этом)
Ваш код можно заменить несколькими строками

Visual Basic
1
2
3
4
Rows(4 + x & ":" & 2000).Hidden = False
x = Cells(2, 4)
lLastRow = Cells.SpecialCells(xlLastCell).Row
Rows(4 + x & ":" & lLastRow).Hidden = True

@Archi992 · 15.10.2019, 17:16 **[ТС]**

АЕ, спасибо, что посмотрели.
Возможно, действительно, будет понятней, если взглянуть на сам отчет.
Прикрепляю в архиве "Форма".

Поэтому Ваше предложение по поводу писать в строку отпадает.
Буду признателен за полезные советы.

@АЕ · 15.10.2019, 20:56

Сообщение от Archi992

если взглянуть на сам отчет.
Прикрепляю в архиве "Форма".

Archi992, на поверку форма оказалась отчетом. Уже понятнее. Я не придираюсь. Вы сами можете погуглить, что такое формы в эксэль. Вы используете слова не понимая что они обозначают, а это вводит в заблуждение.
Позже (по настроению) сооружу универсальную подпрограмму. Она может помочь доработать ваш отчет.

@Archi992 · 15.10.2019, 21:33 **[ТС]**

АЕ, спасибо за уделённое время) буду благодарен за Вашу помощь!

@АЕ · 15.10.2019, 21:35

Ну вот наваял небольшое.....

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Public Sub MacroAE1()
x = Cells(275, 16)
y = Cells(275, 15)
 
Select Case y
Case 1
Z = 286
Case 2
Z = 295
Case 3
Z = 305
Case Else
Z = 315
End Select
 
If x = 0 Then
    MacroAE Z, 278, 315
Else
    MacroAE 277, 278, 315
End If
End Sub
 
Public Sub MacroAE(n, s, f) ' макрос скрывает n-ное количество строк в диапазоне от s до f
'n -количество строк
's - старт в строке
'f - финиш в строке
Rows(s & ":" & f).Hidden = False
Rows(n & ":" & f).Hidden = True
End Sub

Это для конкретной строки "Наличие документации по планировке территории (ДПТ)"
Файл с применением выложить?

Добавлено через 2 минуты
Остальное можете допилить по аналогии

@АЕ · 15.10.2019, 21:39

файл вложил

@Archi992 · 15.10.2019, 21:40 **[ТС]**

АЕ, спасибо большое) завтра доберусь до компьютера и буду разбираться. По аналогии будет уже проще делать) файл с применением тоже будет не лишним)

Новые блоги и статьи Все статьи Все блоги /
делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью	SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .
Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .	Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .

@АЕ ᴁ © 4159 / 2448 / 508 Регистрация: 13.12.2016 Сообщений: 8,320 Записей в блоге: 5
	15.10.2019, 14:31
	Archi992, я раза 4 перечитал задачку.... Не пойму для чего штаны через голову надевать... Ну съезжать ничего не будет если массивы располагать горизонтально а вертикально. Как должна выглядеть форма? Вы бы ее нарисовали. Понять было бы проще понять что вам требуется. В VBA эксэль ничего не адаптировал и похоже не будет. Для этого используют относительные ссылки типа Cells(1, 1).CurrentRegion.Rows.Count 1

@Archi992 0 / 0 / 0 Регистрация: 08.10.2019 Сообщений: 8
	15.10.2019, 15:34 [ТС]
	"Ну съезжать ничего не будет если массивы располагать горизонтально а вертикально." - это как? Форму я прикладывал к теме, прикреплю еще раз. Попробую разъяснить суть задачки, может я действительно не с той стороны подошел к вопросу. У меня есть форма отчета, в которой очень много пунктов и количество подпунктов в них зависит от определенного значения. Например, у есть пункт "Кол-во этапов строительства", где пользователю предлагается выбрать соответствующую цифру из выпадающего списка. Далее, если допустим было выбрано "5", то в следующих пунктах должны развернуться по 5 подпунктов для заполнения. В некоторых пунктах есть значение "не требуется" и тогда содержимое этого пункта полностью сворачивается. Также в модуле листа прописан код, чтобы запускался макрос при редактировании определенной ячейки. Прописав соответствующие коды я смог добиться корректной работы макроса, но осталась проблема с добавлением\удалением строк. Рэнджи макроса съезжают. 0

@Archi992 0 / 0 / 0 Регистрация: 08.10.2019 Сообщений: 8
	15.10.2019, 15:58 [ТС]
	Возможно кто-то подскажет как еще возможно выполнить поставленную задачу или упростить\усовершенствовать имеющийся подход. Буду очень благодарен за помощь и советы Добавлено через 14 минут Narimanych, а можете пояснить что делает этот код? Как для чайника, пожалуйста 0

@Archi992 0 / 0 / 0 Регистрация: 08.10.2019 Сообщений: 8
	15.10.2019, 16:59 [ТС]
	АЕ, смотрите внимательней выше. Прикреплен ZIP архив. 0

@Archi992 0 / 0 / 0 Регистрация: 08.10.2019 Сообщений: 8
	15.10.2019, 21:33 [ТС]
	АЕ, спасибо за уделённое время) буду благодарен за Вашу помощь! 0

@Archi992 0 / 0 / 0 Регистрация: 08.10.2019 Сообщений: 8
	15.10.2019, 21:40 [ТС]
	АЕ, спасибо большое) завтра доберусь до компьютера и буду разбираться. По аналогии будет уже проще делать) файл с применением тоже будет не лишним) 0