Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выпадающий список с возможностью его дополнения - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выпадающий список с возможностью его дополнения (Макросы/Sub)
Выпадающий список с возможностью его дополнения
Xpert Дата: Четверг, 10.01.2019, 16:09 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 115
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте, дамы и господа!
Вопрос: как сделать так, чтобы условия, заданные в ячейке A2 "У мной таблицы" на Листе 1, распространялись на ячейки ниже(т.е. A3, A4 и т.д.)?
Понимаю, что нужно как-то по-другому задать адрес диапазона в макросе, но не соображу как.
Пример прилагаю.
К сообщению приложен файл: _.xlsx.xlsm (18.7 Kb)
 
Ответить
СообщениеЗдравствуйте, дамы и господа!
Вопрос: как сделать так, чтобы условия, заданные в ячейке A2 "У мной таблицы" на Листе 1, распространялись на ячейки ниже(т.е. A3, A4 и т.д.)?
Понимаю, что нужно как-то по-другому задать адрес диапазона в макросе, но не соображу как.
Пример прилагаю.

Автор - Xpert
Дата добавления - 10.01.2019 в 16:09
_Boroda_ Дата: Четверг, 10.01.2019, 16:28 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16674
Репутация: 6479 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Четвертую строчку замените на проверку номера столбца. Ну и добавил строку, чтобы шапку не трогало. И формулу с именованном диапазоне поменял, СЧЁТЗ побыстрее будет
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column = 1 Then
        If IsEmpty(Target) Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("Лист2").Range("NaMs"), Target) = 0 Then
            lReply = MsgBox("Добавить введенное имя " & _
                Target & " в выпадающий список?", vbYesNo + vbQuestion)
            If lReply = vbYes Then
                Sheets("Лист2").Range("NaMs").Cells(Sheets("Лист2").Range("NaMs").Rows.Count + 1, 1) = Target
            End If
        End If
    End If
    Sheets("Лист2").Range("NaMs").Sort Key1:=Sheets("Лист2").Range("NaMs"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
[/vba]
К сообщению приложен файл: _9.xlsm (19.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЧетвертую строчку замените на проверку номера столбца. Ну и добавил строку, чтобы шапку не трогало. И формулу с именованном диапазоне поменял, СЧЁТЗ побыстрее будет
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lReply As Long
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column = 1 Then
        If IsEmpty(Target) Then Exit Sub
        If WorksheetFunction.CountIf(Sheets("Лист2").Range("NaMs"), Target) = 0 Then
            lReply = MsgBox("Добавить введенное имя " & _
                Target & " в выпадающий список?", vbYesNo + vbQuestion)
            If lReply = vbYes Then
                Sheets("Лист2").Range("NaMs").Cells(Sheets("Лист2").Range("NaMs").Rows.Count + 1, 1) = Target
            End If
        End If
    End If
    Sheets("Лист2").Range("NaMs").Sort Key1:=Sheets("Лист2").Range("NaMs"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.01.2019 в 16:28
sboy Дата: Четверг, 10.01.2019, 16:35 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация: 724 ±
Замечаний: 0% ±

Excel 2010
А если именно для умной таблицы, то тогда так можно написать
[vba]
Код
If Not Intersect(Target, ListObjects("Таблица1").ListColumns(1).Range) Is Nothing Then
[/vba]


Яндекс: 410016850021169
 
Ответить
СообщениеА если именно для умной таблицы, то тогда так можно написать
[vba]
Код
If Not Intersect(Target, ListObjects("Таблица1").ListColumns(1).Range) Is Nothing Then
[/vba]

Автор - sboy
Дата добавления - 10.01.2019 в 16:35
Xpert Дата: Четверг, 10.01.2019, 16:36 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 115
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Александр, _Boroda_, блестяще!
sboy, спасибо и Вам!


Сообщение отредактировал Xpert - Четверг, 10.01.2019, 16:38
 
Ответить
СообщениеАлександр, _Boroda_, блестяще!
sboy, спасибо и Вам!

Автор - Xpert
Дата добавления - 10.01.2019 в 16:36
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выпадающий список с возможностью его дополнения (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!