Добрый день. Подскажите пожалуйста как заставить макрос создавать Именованный диапазон, со сдвигом на две клетки вправо при условии, что над этими клетками пустая ячейка. Файл примера прилагается, код по максимуму откомментировал, за ранее спасибо.
Добрый день. Подскажите пожалуйста как заставить макрос создавать Именованный диапазон, со сдвигом на две клетки вправо при условии, что над этими клетками пустая ячейка. Файл примера прилагается, код по максимуму откомментировал, за ранее спасибо.Kamikadze_N
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("B:B")) Is Nothing Then UserForm1.Show
'если у нас отсутствует значение в именованом диапазоне мы его добавим
If IsEmpty(Target) Then Exit Sub 'если нажата клавиша эскейп то заканчиваем работу с выделеной ячейкой
If WorksheetFunction.CountIf(Worksheets("dbTresh").Range("ФИО"), Target) = 0 Then 'выполняем поиск в диапазоне на наличие там имеющегося значения lReply = MsgBox("Добавить новое значение " & _ Target & " в БД?", vbYesNo + vbQuestion) If lReply = vbYes Then
'вставляем в именованый диапазон новое значение
sch = 4 Do While Worksheets("dbTresh").Cells(sch, 1) <> "" 'Находим первую пустую строку в именованом диапазоне sch = sch + 1 Loop
Worksheets("dbTresh").Cells(sch, 1) = Target 'присваиваем этой строке значение из комбобокс
'создаем именованный диапазон для этого найдем его местоположение в БД Sheets("dbDiap").Select schI = 1 Do While Worksheets("dbDiap").Cells(3, schI) <> "" 'Находим первый пустой столбец schI = schI + 2 Loop
'собственно как заставить создаваться Диапазон в зависимости от Толбца? Worksheets("dbDiap").Cells(3, schI) = Target.Value ActiveWorkbook.Worksheets("dbDiap").Names.Add Name:=Target.Value, _ RefersTo:=Worksheets("dbDiap").Cells(3, schI).Resize(9)
End If End If End If End Sub
[/vba]
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("B:B")) Is Nothing Then UserForm1.Show
'если у нас отсутствует значение в именованом диапазоне мы его добавим
If IsEmpty(Target) Then Exit Sub 'если нажата клавиша эскейп то заканчиваем работу с выделеной ячейкой
If WorksheetFunction.CountIf(Worksheets("dbTresh").Range("ФИО"), Target) = 0 Then 'выполняем поиск в диапазоне на наличие там имеющегося значения lReply = MsgBox("Добавить новое значение " & _ Target & " в БД?", vbYesNo + vbQuestion) If lReply = vbYes Then
'вставляем в именованый диапазон новое значение
sch = 4 Do While Worksheets("dbTresh").Cells(sch, 1) <> "" 'Находим первую пустую строку в именованом диапазоне sch = sch + 1 Loop
Worksheets("dbTresh").Cells(sch, 1) = Target 'присваиваем этой строке значение из комбобокс
'создаем именованный диапазон для этого найдем его местоположение в БД Sheets("dbDiap").Select schI = 1 Do While Worksheets("dbDiap").Cells(3, schI) <> "" 'Находим первый пустой столбец schI = schI + 2 Loop
'собственно как заставить создаваться Диапазон в зависимости от Толбца? Worksheets("dbDiap").Cells(3, schI) = Target.Value ActiveWorkbook.Worksheets("dbDiap").Names.Add Name:=Target.Value, _ RefersTo:=Worksheets("dbDiap").Cells(3, schI).Resize(9)
Если данные добавлять снизу, то диапазон не включит в себя эти нижние данные. Если же добавлять строки внутри диапазона, то строки будут включены в диапазон, то есть диапазон расширится.
Если данные добавлять снизу, то диапазон не включит в себя эти нижние данные. Если же добавлять строки внутри диапазона, то строки будут включены в диапазон, то есть диапазон расширится.Karataev
Karataev, А вы случайно не подскажите как этот диапазон распространить на всю книгу. Прост при создании макросом именованные диапазоны работают только на листе bdDiap. А нужно что бы они были доступны во всей книге.
Karataev, А вы случайно не подскажите как этот диапазон распространить на всю книгу. Прост при создании макросом именованные диапазоны работают только на листе bdDiap. А нужно что бы они были доступны во всей книге.Kamikadze_N