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

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

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

Добрый день!

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

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

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

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

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

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

Visual Basic

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

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

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

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

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 **[ТС]**

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

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

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

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

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

@АЕ ᴁ® 3638 / 1997 / 423 Регистрация: 13.12.2016 Сообщений: 6,861 Записей в блоге: 5
	15.10.2019, 16:19	8
	Сообщение от Archi992 Форму я прикладывал к теме, прикреплю еще раз. Еще раз приложенной формы в модуле с кодом не обнаружил. Что вы формой называете? Может мы говорим на разных языках? 0

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

@АЕ ᴁ® 3638 / 1997 / 423 Регистрация: 13.12.2016 Сообщений: 6,861 Записей в блоге: 5
	15.10.2019, 20:56	12
	Сообщение от Archi992 если взглянуть на сам отчет. Прикрепляю в архиве "Форма". Archi992, на поверку форма оказалась отчетом. Уже понятнее. Я не придираюсь. Вы сами можете погуглить, что такое формы в эксэль. Вы используете слова не понимая что они обозначают, а это вводит в заблуждение. Позже (по настроению) сооружу универсальную подпрограмму. Она может помочь доработать ваш отчет. 0

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