Макрос выпадающего списка с полем для заполнения

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Макрос выпадающего списка с полем для заполнения (Макросы/Sub)

walkinghome

Дата: Среда, 06.01.2021, 16:48 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 25

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Доброго времени суток и с новым годом!

Нашел неплохой макрос, позволяющий проводить поиск по введенным буквам запроса (в данном случае улиц, см. Пример1) и выбору подходящего из выпадающего списка снизу. Сам макрос работает хорошо, однако часто вылезает ошибка "Индекс вне заданного диапазона" или "Subscript out of range". Данное можно увидеть, например нажав на уже заполненную макросом ячейку C3 на листе Otchet. Не подскажете в чем состоит причина ошибки и возможно ли её точечно исправить? Либо же проще написать весь код с нуля?

Небольшое замечание, но тем не менее: данный макрос не позволяет вернуть уже проведенные действия (словом, функция Ctrl+Z всегда недоступна). Не подскажете что может являться причиной данной ошибки?

Буду благодарен за любое содействие, спасибо.

К сообщению приложен файл: 6632101.xlsm (37.2 Kb)

Выражение - вооружение

Ответить

RAN

Дата: Среда, 06.01.2021, 19:18 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Цитата walkinghome, 06.01.2021 в 16:48, в сообщении № 1 ()

данный макрос не позволяет вернуть уже проведенные действия (словом, функция Ctrl+Z всегда недоступна). Не подскажете что может являться причиной данной ошибки?

Причина в том, что никакой ошибки нет. Макрос (любой) и "функция Ctrl+Z", вещи не совместимые.

Быть или не быть, вот в чем загвоздка!

Ответить

MikeVol

Дата: Четверг, 07.01.2021, 01:13 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 378

Репутация: 81 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

walkinghome, Попробуйте изменить:
[vba]

Код

Sub GetArray()

    'взяли данные в массив
    With Sheets("Baza")
        aSpisok = .Range("$A$2:$A$30" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
    End With

End Sub

[/vba]
~~У меня ошибка не выскакивает больше.~~

UPD: Не помогло, всё же выскакивает ошибка. Извините.

Ученик.
Одесса - Украина

Сообщение отредактировал MikeVol - Четверг, 07.01.2021, 01:35

Ответить

Pelena

Дата: Четверг, 07.01.2021, 13:38 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 19404

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

walkinghome, есть похожее готовое решение, неоднократно проверенное

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

RAN

Дата: Четверг, 07.01.2021, 14:13 | Сообщение № 5

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Дык и этот код рабочий.
Все дело в том, что сначала идет запись данных, и только потом получение этих данных (GetArray). И, при определенных условиях, aSpisok пустой. Что и дает ошибку. Достаточно передвинуть GetArray в начало.
[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ListBox1.Visible = False
If Target.Count > 1 Then Exit Sub
    If Not Intersect(ActiveCell, Range("C3:C8")) Is Nothing Then
                 GetArray
           With TextBox1
                .Value = Empty
                If Target <> "" Then .Value = Target
                .Top = ActiveCell.Top
                .Width = ActiveCell.Width
                .Left = ActiveCell.Left
                .Height = ActiveCell.Height + 2
                .Font.Size = ActiveCell.Font.Size
                .Visible = True
                .Activate
            End With
    Else: TextBox1.Visible = False: ListBox1.Visible = False
    End If

End Sub

[/vba]