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

Вход

Регистрация

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

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 56887
Главная » Готовые решения » VBA » Полезные приёмы

Раскрывающиеся списки на листе
17.10.2015, 09:48
[ Файл-пример (28.8 Kb) ]

Списки валидации и комбобоксы (AtiveX)

Sub Example_01() 'Заполнить список в D1 без повторов
Dim i As Long, x As New Collection, poz As Range, s As String
On Error Resume Next: Err.Clear
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
 If Cells(i, "A") <> vbNullString Then
 x.Add Cells(i, 1), CStr(Cells(i, 1))
 If Err = 0 Then s = s & "," & Cells(i, "A") Else Err.Clear
 End If
Next
On Error GoTo 0
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub
Sub Example_01_1() 'Заполнить список в D1 без повторов
Dim i As Long, x, s As String
s = ","
For Each x In Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
 If Len(x) Then If InStr(s, "," & x & ",") = 0 Then s = s & x & ","
Next
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub
Sub Example_01_3() 'Заполнить список в D1 без повторов с сортировкой
Dim x, i&, s As String
x = Range("A2", Cells(Rows.Count, 1).End(xlUp)).Value
With CreateObject("System.Collections.ArrayList")
 For i = 1 To UBound(x)
 If Len(x(i, 1)) Then If Not .Contains(x(i, 1)) Then .Add x(i, 1)
 Next i
 .Sort
 ' .Insert 0, "Выбор ФИО" 'вставить Заголовок в 1-ю позицию (индекс 0)
 s = Join(.toarray, ",")
End With
With Range("D1").Validation
 .Delete: .Add Type:=xlValidateList, Formula1:=s
End With
End Sub
Sub Example_02() 'Заполнить ComboBox1 без повторов с сортировкой
'с использованием ф-ции NoDups от ZVI (см. Модуль2 в файле)
Dim Rng As Range
' чтобы не париться, можно задать весь столбец, NoDups ограничит его по UsedRange
Set Rng = Sheets("Sheet1").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
With Sheets(1).ComboBox1
 .Clear
 .List = NoDups(Rng)
 .ListIndex = 0
End With
End Sub
Добавил: nilem | | Теги: комбобоксы, Списки валидации
Просмотров: 5183 | Рейтинг: 5.0/1
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!