Помогите решить проблему с именованным диапазоном. Есть таблица C5:E32, она заполнена числами. Но нижняя граница - которая сейчас проходит по строке 23 - бывает то выше, то ниже. В зависимости от того где начинается та первая строка, в которой все три значения - 0. Сейчас все три значения - 0 в строке 24 (C24,D24,E24) ... а значит нижняя граница диапазона должна проходить по строке 23.
Вопрос - как макросом в самом именованном диапазоне - изменить границы диапазона (в зависимости от того, где проходит нижняя его граница) ?
Вот я тут примерно в файле нарисовал - там где одни нули - там красный шрифт, а где числа которые должны входить в диапазон - там зеленым шрифтом подкрасил - чтобы нагляднее было.
Доброго времени суток.
Помогите решить проблему с именованным диапазоном. Есть таблица C5:E32, она заполнена числами. Но нижняя граница - которая сейчас проходит по строке 23 - бывает то выше, то ниже. В зависимости от того где начинается та первая строка, в которой все три значения - 0. Сейчас все три значения - 0 в строке 24 (C24,D24,E24) ... а значит нижняя граница диапазона должна проходить по строке 23.
Вопрос - как макросом в самом именованном диапазоне - изменить границы диапазона (в зависимости от того, где проходит нижняя его граница) ?
Вот я тут примерно в файле нарисовал - там где одни нули - там красный шрифт, а где числа которые должны входить в диапазон - там зеленым шрифтом подкрасил - чтобы нагляднее было.Glass4217
Sub aaa() Dim aa As Range, dt$, a&, b&, c# Set aa = [C5].CurrentRegion: a = aa.Rows.Count Do On Error Resume Next Do While aa(a, 1) = 0 a = a - 1 If Err Then a = a + 1: Exit Do Loop On Error GoTo 0 If Application.Sum(aa.Rows(a + 1)) = 0 Then Set aa = aa.Rows("1:" & a): Exit Do Loop dt = "=" & ActiveSheet.Name & "!" & aa.Address ThisWorkbook.Names.Item(1).RefersTo = dt End Sub
[/vba]
[vba]
Код
Sub aaa() Dim aa As Range, dt$, a&, b&, c# Set aa = [C5].CurrentRegion: a = aa.Rows.Count Do On Error Resume Next Do While aa(a, 1) = 0 a = a - 1 If Err Then a = a + 1: Exit Do Loop On Error GoTo 0 If Application.Sum(aa.Rows(a + 1)) = 0 Then Set aa = aa.Rows("1:" & a): Exit Do Loop dt = "=" & ActiveSheet.Name & "!" & aa.Address ThisWorkbook.Names.Item(1).RefersTo = dt End Sub
Ну, если формулой не нравится, то можно так попробовать [vba]
Код
Sub aaa() Dim aa As Range, a&, i& Set aa = [C5].CurrentRegion: a = aa.Rows.Count For i = 1 To a If Application.Sum(aa.Cells(i, 1).Resize(, 3)) = 0 Then ThisWorkbook.Names("Диапазон1").RefersTo = "=" & ActiveSheet.Name & "!$C$5:$E$" & i + 3: Exit For End If Next i End Sub
[/vba]
Ну, если формулой не нравится, то можно так попробовать [vba]
Код
Sub aaa() Dim aa As Range, a&, i& Set aa = [C5].CurrentRegion: a = aa.Rows.Count For i = 1 To a If Application.Sum(aa.Cells(i, 1).Resize(, 3)) = 0 Then ThisWorkbook.Names("Диапазон1").RefersTo = "=" & ActiveSheet.Name & "!$C$5:$E$" & i + 3: Exit For End If Next i End Sub
Glass4217, на будущее - файл-пример должен отражать реальную структуру данных. Если именованных диапазонов несколько ,то стоит указать и это. [vba]
Код
Sub aaa() Dim aa As Range, a&, dt$ a = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row Set aa = Intersect(Rows("5:" & a), Columns("C:E")): a = aa.Rows.Count Do On Error Resume Next Do While aa(a, 1) = 0 a = a - 1 If Err Then a = a + 1: Exit Do Loop On Error GoTo 0 If Application.Sum(aa.Rows(a + 1)) = 0 Then Set aa = aa.Rows("1:" & a): Exit Do Else a = a - 1 Loop On Error Resume Next: dt = ThisWorkbook.Names("Диапазон1").RefersTo If Err Then ThisWorkbook.Names.Add "Диапазон1", "=" & ActiveSheet.Name & "!" & aa.Address Else: ThisWorkbook.Names("Диапазон1").RefersTo = "=" & ActiveSheet.Name & "!" & aa.Address End If: Err.Clear End Sub
[/vba] Если вдруг именованные диапазоны куда-то подевались, то макрос добавит.
Glass4217, на будущее - файл-пример должен отражать реальную структуру данных. Если именованных диапазонов несколько ,то стоит указать и это. [vba]
Код
Sub aaa() Dim aa As Range, a&, dt$ a = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row Set aa = Intersect(Rows("5:" & a), Columns("C:E")): a = aa.Rows.Count Do On Error Resume Next Do While aa(a, 1) = 0 a = a - 1 If Err Then a = a + 1: Exit Do Loop On Error GoTo 0 If Application.Sum(aa.Rows(a + 1)) = 0 Then Set aa = aa.Rows("1:" & a): Exit Do Else a = a - 1 Loop On Error Resume Next: dt = ThisWorkbook.Names("Диапазон1").RefersTo If Err Then ThisWorkbook.Names.Add "Диапазон1", "=" & ActiveSheet.Name & "!" & aa.Address Else: ThisWorkbook.Names("Диапазон1").RefersTo = "=" & ActiveSheet.Name & "!" & aa.Address End If: Err.Clear End Sub
[/vba] Если вдруг именованные диапазоны куда-то подевались, то макрос добавит.Anchoret
Сообщение отредактировал Anchoret - Понедельник, 18.03.2019, 00:34
Но макрос почему-то захватывает одну строчку сверху, если в ней - что-то есть. Например когда я размещаю строчкой выше - заголовок - то макрос включает в именованный диапазон и этот заголовок (то есть с четвертой строки его начинает, а не с пятой). Хотя вроде бы - в макросе записано C5 - то есть обозначение верхней границы диапазона (пятая строка).
Почему так происходит и как это поменять ?
Anchoret, вроде бы все работает.
Но макрос почему-то захватывает одну строчку сверху, если в ней - что-то есть. Например когда я размещаю строчкой выше - заголовок - то макрос включает в именованный диапазон и этот заголовок (то есть с четвертой строки его начинает, а не с пятой). Хотя вроде бы - в макросе записано C5 - то есть обозначение верхней границы диапазона (пятая строка).
Почему так происходит и как это поменять ?Glass4217