Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Создание именованного диапазона в VBA
 
Здравствуйте, уважаемые форумчане!


В качестве примера, прикрепил сортированную таблицу учебных заведений с фамилиями учеников и их оценками. Пожалуйста, помогите создать макросом именованные диапазоны так чтобы имена диапазонов брались из столбца "Код уч. заведения".
 
Названия имен, а так же возможность того, что они уже были созданы на Вашей совести :)
Код
Sub CreateNames()
    Dim rr As Range, llastr As Long, lr As Long, lr2 As Long
    llastr = Cells(Rows.Count, 4).End(xlUp).Row
    lr2 = 2
    For lr = 2 To llastr
        If Cells(lr, 4).Value <> Cells(lr + 1, 4).Value Then
            Set rr = Range(Cells(lr2, 1), Cells(lr, 3))
            ActiveWorkbook.Names.Add Cells(lr, 4).Value, rr.Address(1, 1, ReferenceStyle:=Application.ReferenceStyle)
            lr2 = lr
        End If
    Next
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Запись команды Формулы - (Определенные имена) - Создать из выделенного фрагмента - в столбце справа, с небольшой правкой
Код
Sub Макрос1()
  Application.DisplayAlerts = False 'чтобы не подтверждать изменение повторяющихся имен
  Range("A2", Cells(Rows.Count, "D").End(xlUp)).CreateNames Top:=False, Left:=False, Bottom:=False, Right:=True
  Application.DisplayAlerts = True
End Sub
 
Алексей, а разве так создадутся правильные диапазоны для имен? Не по одной ли строке будет в каждом?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий, Ваш код работает, диапазоны создаются, но с небольшой ошибкой. Видимо я не обозначил как будут создаваться диапазоны...

Я руками создаю диапазон следующим образом: 1. Создаю диапазон с именем "Ш27_Отметка", 2. В этот диапазон попадают ВСЕ значения для "ШКОЛЫ 27" и ТОЛЬКО из столбца "С" (Оценка), 3. Повторяю шаг 1-2 для всех учебных заведений.
В итоге получаются диапазоны ("ИМЯ ДИАПАЗОНА"={ЗНАЧЕНИЕ1:ЗНАЧЕНИЕ2:...:ЗНАЧЕНИЕN})
Ш27_Отметка={4:4:5} (для ШКОЛА 27)
Ш30_Отметка={5:3} (для ШКОЛА 30)
Ш31_Отметка={3:4} (для ШКОЛА 31)

Ваш код я немного переработал чтоб создавался диапазон по одному столбцу а не из нескольких:
сделал так: Set rr = Range(Cells(lr2, 3), Cells(lr, 3))
НО!!!
"Адресация" не верная. У диапазона Ш27_Отметка адреса: С2:С4, у Ш30_Отметка: С4:С6, у Ш31_Отметка: С6:С8 - т.е. адрес начала ячейки следующего диапазона равен адресу последней ячейки предыдущего диапазона. Как бы так подправить!? Я с vba 2-й день как знаком, поэтому прошу помощи!!!
 
Получилось сделать так:
Код
Sub CreateNames_OU()

    Dim rr As Range, llastr As Long, lr As Long, lr2 As Long, lr3 As Long

    llastr = Cells(Rows.Count, 4).End(xlUp).Row
    lr2 = 1
    For lr = 2 To llastr
        If Cells(lr, 4).Value <> Cells(lr + 1, 4).Value Then
            lr3 = lr2 + 1
            Set rr = Range(Cells(lr3, 3), Cells(lr, 3))
            ActiveWorkbook.Names.Add Cells(lr, 4).Value, rr.Address(1, 1, ReferenceStyle:=Application.ReferenceStyle)
            lr2 = lr
        End If
    Next
End Sub



НО! Диапазон создаётся, но его содержимое равняется тексту! Пробовал так... Создал диапазон руками, вбил в пустую ячейку "=Ш27_Отметка", нажал ввод, - возвращаюсь редактировать ячейку куда вбивал "=Ш27_Отметка" - текст синий в строке редактирования и синей рамкой показывает диапазон. А "програмный" диапазон "Ш27_Отметка" так же вбиваю в пустую ячейку - отображает в ней текст "C$2:C$4". Нужно разобраться как нужно правильно (программно) "собрать" диапазон...
Изменено: xploid - 28 Авг 2018 01:32:21
 
я конечно понимаю, ТС поставил вопрос - на него отвечают. Но можно встречный вопрос - зачем вам плодить именованные диапазоны для оценок?
считать средний балл? возможно ТС не знает о существовании функций (СУММ/СЧЁТ/СРЗНАЧ)ЕСЛИ и пытается изобрести велосипед?
 
Код
Sub CreateNames()
    Dim rr As Range, llastr As Long, lr As Long, lr2 As Long
    llastr = Cells(Rows.Count, 4).End(xlUp).Row
    lr2 = 2
    For lr = 2 To llastr
        If Cells(lr, 4).Value <> Cells(lr + 1, 4).Value Then
            Set rr = Range(Cells(lr2, 3), Cells(lr, 3))
            ActiveWorkbook.Names.Add Cells(lr, 4).Value, "=" & rr.Address(1, 1, ReferenceStyle:=Application.ReferenceStyle)
            lr2 = lr + 1
        End If
    Next
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Читают тему (гостей: 1)
Наверх