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

Вход

Регистрация

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

 

= Мир MS Excel/Создание выпадающего списка на нескольких листах - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание выпадающего списка на нескольких листах (Макросы/Sub)
Создание выпадающего списка на нескольких листах
koyaanisqatsi Дата: Среда, 20.04.2016, 01:08 | Сообщение № 1
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте.

Помогите пожалуйста обуздать Код предложенный в этой ветке.

[vba]
Код
Option Explicit
Option Compare Text
Dim bu As Boolean, cl As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Select Case Target.Column
    Case 4, 17
        If Target.Row > 3 Then
            bu = True
            With Me.TextBox1
                .Top = Target.Top: .Left = Target.Left: .Text = Target.Value: .Activate
            End With

            With Me.ListBox1
                .Top = Target.Top - 20: .Left = Target.Left + 143: .Clear
            End With
            cl = IIf(Target.Column = 4, 22, 25): bu = False
            Me.TextBox1.Visible = True: Me.ListBox1.Visible = True
        End If
    Case Else
        Me.TextBox1.Visible = False: Me.ListBox1.Visible = False
End Select
End Sub

Private Sub TextBox1_Change()
Dim x, i As Long, txt As String, lt As Long, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub

txt = TextBox1.Text: lt = Len(TextBox1.Text)
x = Columns(cl).SpecialCells(2).Value

For i = 1 To UBound(x, 1)    ' ïîèñê ïî ïåðâûì áóêâàì
    If txt = Mid(x(i, 1), 1, lt) Then s = s & x(i, 1) & "~"
Next i
ListBox1.List = Split(s, "~")
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
bu = True
ActiveCell.Value = ListBox1.Value
Me.TextBox1.Text = ListBox1.Value
bu = False
End Sub

Sub tt()
Application.EnableEvents = True
End Sub

[/vba]

У меня выскакивает ошибка в этой строке.

[vba]
Код
x = Columns(cl).SpecialCells(2).Value
[/vba]

Но мне еще надо понять как указывать откуда брать данные для списка. Так как я хочу с любой страницы вызывать один и тот же список который расположен на одной странице.

Выбрал именно этот пример так как на страничке в оригинальном примере "ENTRYYY" подлагивает, толи дважды кликнуть надо то ли еще как подшаманить. Просто начать писать не выходит.
А на страничке "ENTRY" можно сразу писать и он подсказывает. Только почему-то у меня не срабатывает ((((
К сообщению приложен файл: 4423018222.xlsm(26Kb)


Сообщение отредактировал koyaanisqatsi - Среда, 20.04.2016, 01:13
 
Ответить
СообщениеЗдравствуйте.

Помогите пожалуйста обуздать Код предложенный в этой ветке.

[vba]
Код
Option Explicit
Option Compare Text
Dim bu As Boolean, cl As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Select Case Target.Column
    Case 4, 17
        If Target.Row > 3 Then
            bu = True
            With Me.TextBox1
                .Top = Target.Top: .Left = Target.Left: .Text = Target.Value: .Activate
            End With

            With Me.ListBox1
                .Top = Target.Top - 20: .Left = Target.Left + 143: .Clear
            End With
            cl = IIf(Target.Column = 4, 22, 25): bu = False
            Me.TextBox1.Visible = True: Me.ListBox1.Visible = True
        End If
    Case Else
        Me.TextBox1.Visible = False: Me.ListBox1.Visible = False
End Select
End Sub

Private Sub TextBox1_Change()
Dim x, i As Long, txt As String, lt As Long, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub

txt = TextBox1.Text: lt = Len(TextBox1.Text)
x = Columns(cl).SpecialCells(2).Value

For i = 1 To UBound(x, 1)    ' ïîèñê ïî ïåðâûì áóêâàì
    If txt = Mid(x(i, 1), 1, lt) Then s = s & x(i, 1) & "~"
Next i
ListBox1.List = Split(s, "~")
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListIndex = -1 Then Exit Sub
bu = True
ActiveCell.Value = ListBox1.Value
Me.TextBox1.Text = ListBox1.Value
bu = False
End Sub

Sub tt()
Application.EnableEvents = True
End Sub

[/vba]

У меня выскакивает ошибка в этой строке.

[vba]
Код
x = Columns(cl).SpecialCells(2).Value
[/vba]

Но мне еще надо понять как указывать откуда брать данные для списка. Так как я хочу с любой страницы вызывать один и тот же список который расположен на одной странице.

Выбрал именно этот пример так как на страничке в оригинальном примере "ENTRYYY" подлагивает, толи дважды кликнуть надо то ли еще как подшаманить. Просто начать писать не выходит.
А на страничке "ENTRY" можно сразу писать и он подсказывает. Только почему-то у меня не срабатывает ((((

Автор - koyaanisqatsi
Дата добавления - 20.04.2016 в 01:08
doober Дата: Среда, 20.04.2016, 02:35 | Сообщение № 2
Группа: Друзья
Ранг: Обитатель
Сообщений: 407
Репутация: 200 ±
Замечаний: 0% ±

Excel 2007
А так ?[vba]
Код
Private Sub TextBox1_Change()
Dim x, i As Long, txt As String, lt As Long, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub
txt = TextBox1.Text: lt = Len(TextBox1.Text)
x = Range(Cells(1, 17), Cells(Rows.Count, 17).End(xlUp))
For i = 1 To UBound(x, 1)    ' поиск по первым буквам
    If txt = Mid(x(i, 1), 1, lt) Then s = s & x(i, 1) & "~"
Next i
ListBox1.List = Split(s, "~")
End Sub
[/vba]


 
Ответить
СообщениеА так ?[vba]
Код
Private Sub TextBox1_Change()
Dim x, i As Long, txt As String, lt As Long, s As String
If Len(TextBox1.Text) = 0 Or bu Then Exit Sub
txt = TextBox1.Text: lt = Len(TextBox1.Text)
x = Range(Cells(1, 17), Cells(Rows.Count, 17).End(xlUp))
For i = 1 To UBound(x, 1)    ' поиск по первым буквам
    If txt = Mid(x(i, 1), 1, lt) Then s = s & x(i, 1) & "~"
Next i
ListBox1.List = Split(s, "~")
End Sub
[/vba]

Автор - doober
Дата добавления - 20.04.2016 в 02:35
koyaanisqatsi Дата: Среда, 20.04.2016, 07:41 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
doober, А так нету ошибки ) Спасибо. hands Единственное ни стрелками ни ентером ни выйти из ввода контрагента.

А как перенести список на другую страницу ?


Сообщение отредактировал koyaanisqatsi - Среда, 20.04.2016, 07:43
 
Ответить
Сообщениеdoober, А так нету ошибки ) Спасибо. hands Единственное ни стрелками ни ентером ни выйти из ввода контрагента.

А как перенести список на другую страницу ?

Автор - koyaanisqatsi
Дата добавления - 20.04.2016 в 07:41
doober Дата: Среда, 20.04.2016, 21:23 | Сообщение № 4
Группа: Друзья
Ранг: Обитатель
Сообщений: 407
Репутация: 200 ±
Замечаний: 0% ±

Excel 2007
А как перенести список на другую страницу ?

Перенес, но самому такая реализация не совсем нравится, а на толковое решение времени сейчас нет
Выходит и по ентеру и по дабл клику в листбоксе
К сообщению приложен файл: 9683992.xlsm(45Kb)




Сообщение отредактировал doober - Среда, 20.04.2016, 21:27
 
Ответить
Сообщение
А как перенести список на другую страницу ?

Перенес, но самому такая реализация не совсем нравится, а на толковое решение времени сейчас нет
Выходит и по ентеру и по дабл клику в листбоксе

Автор - doober
Дата добавления - 20.04.2016 в 21:23
МВТ Дата: Среда, 20.04.2016, 21:46 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 476
Репутация: 136 ±
Замечаний: 0% ±

Excel 2007
koyaanisqatsi, а чем Вам, в конечном итоге, мой вариант не понавился?
 
Ответить
Сообщениеkoyaanisqatsi, а чем Вам, в конечном итоге, мой вариант не понавился?

Автор - МВТ
Дата добавления - 20.04.2016 в 21:46
koyaanisqatsi Дата: Среда, 20.04.2016, 23:06 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
МВТ, Я хотел без дополнительного окна.
Сложно объяснить на словах.

Хочется чтобы можно было с клавиатуры бегать по таблице и в нужном столбце бы автоматом вспомогательное окошко всплывало с подсказкой и в ячейке ввода программа бы старалась подсказать по первым символам какие еще есть варианты. Знаете как в проводнике реализовано если много файлов и на любой ткнуть и начать писать то он автоматом начнет спускаться по уже введенным буквам до файла с такими же первыми буквам. Вот что-то подобное хочется.
 
Ответить
СообщениеМВТ, Я хотел без дополнительного окна.
Сложно объяснить на словах.

Хочется чтобы можно было с клавиатуры бегать по таблице и в нужном столбце бы автоматом вспомогательное окошко всплывало с подсказкой и в ячейке ввода программа бы старалась подсказать по первым символам какие еще есть варианты. Знаете как в проводнике реализовано если много файлов и на любой ткнуть и начать писать то он автоматом начнет спускаться по уже введенным буквам до файла с такими же первыми буквам. Вот что-то подобное хочется.

Автор - koyaanisqatsi
Дата добавления - 20.04.2016 в 23:06
koyaanisqatsi Дата: Среда, 20.04.2016, 23:14 | Сообщение № 7
Группа: Проверенные
Ранг: Ветеран
Сообщений: 643
Репутация: 15 ±
Замечаний: 0% ±

Excel 2010
doober, У вас кстати почти идеальная реализация. Мне кажется если ее еще чуть до идеала допилить можно в копилку знаний класть откуда я изначальный выцепил.

Что можно улучшить в последнем варианте.

В нужном столбце когда происходит ввод:
1. В нем уже должен появляться первый подходящий контрагент.
2. Выход из ячейки должен происходить по всем клавишам: мышка клик в другую ячейку, стрелки, ентер. При этом должен сохранять последний попавшийся контрагент. (Хотя может быть было бы идеальнее если бы стрелка вниз разрешала из списка выбрать нужный и по ентеру или стрелке в право или клику мышки выходило.)

Хочется запилить такой подбор контрагентов для диспетчеров. А они должны информацию вися на телефоне оперативно вбивать. Поэтому чем сильнее облегчится ввод тем спокойнее и комфортнее будет работа у диспетчера.

Спасибо.
 
Ответить
Сообщениеdoober, У вас кстати почти идеальная реализация. Мне кажется если ее еще чуть до идеала допилить можно в копилку знаний класть откуда я изначальный выцепил.

Что можно улучшить в последнем варианте.

В нужном столбце когда происходит ввод:
1. В нем уже должен появляться первый подходящий контрагент.
2. Выход из ячейки должен происходить по всем клавишам: мышка клик в другую ячейку, стрелки, ентер. При этом должен сохранять последний попавшийся контрагент. (Хотя может быть было бы идеальнее если бы стрелка вниз разрешала из списка выбрать нужный и по ентеру или стрелке в право или клику мышки выходило.)

Хочется запилить такой подбор контрагентов для диспетчеров. А они должны информацию вися на телефоне оперативно вбивать. Поэтому чем сильнее облегчится ввод тем спокойнее и комфортнее будет работа у диспетчера.

Спасибо.

Автор - koyaanisqatsi
Дата добавления - 20.04.2016 в 23:14
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание выпадающего списка на нескольких листах (Макросы/Sub)
Страница 1 из 11
Поиск:

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