Список без повторов

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Список без повторов (Макросы/Sub)

Список без повторов

Паштет

Дата: Воскресенье, 24.06.2018, 13:02 | Сообщение № 1

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

Ранг: Форумчанин

Сообщений: 155

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

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

Excel 2010

Доброго времени суток.
Вроде и избитая тема. Нужен список к Combobox без повторов, берущийся с листа.
Вставил в свою форму такой код:
[vba]

Код

arr = Range(Sheets("Журнал ИБ").Cells(5, 11), Sheets("Журнал ИБ").Cells(Rows.Count, "K").End(xlUp)).Value
    With CreateObject("Scripting.Dictionary")
        For i = LBound(arr) To UBound(arr)
            .Item(arr(i, 1)) = 1
        Next
        Me.fio1.List = .Keys
    End With

[/vba]
При первом запуске формы все работает отлично, но после записи данных и перезагрузки формы ругается на не совместимый тип данных. В чем дело понять не могу.

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

Сообщение отредактировал Паштет - Воскресенье, 24.06.2018, 13:03

Ответить

RAN

Дата: Воскресенье, 24.06.2018, 13:15 | Сообщение № 2

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

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

Сообщений: 5660

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

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

2010

Форму из самой себя закрыть можно, a вот открыть - нет.

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

Ответить

krosav4ig

Дата: Воскресенье, 24.06.2018, 14:35 | Сообщение № 3

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

Ранг: Старожил

Сообщений: 2347

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

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

Excel 2007,2010,2013

как-то так
[vba]

Код

Private Sub UserForm_Initialize()

    Dim iLastRow As Long
    Dim Dic As Object

    iLastRow = Sheets("Журнал ИБ").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Akt = iLastRow - 4
    'Cells(iLastRow, 1) = Akt

    karta1 = Akt

    'zakaz = Application.Max(Sheets("Журнал ИБ").Range("N5:N")) + 1
    'spisanie = Application.Max(Sheets("Журнал ИБ").Range("O5:O")) + 1
    zakaz = Akt
    spisanie = Akt

    Data1 = Format(Date, "dd.mm.yyyy")
    Data2 = Format(Date, "dd.mm.yyyy")
    Data3 = Format(Date, "dd.mm.yyyy")
    Data4 = Format(Date, "dd.mm.yyyy")

    'список для наименований
    Dim i As Long
    i = 2
    Do While Sheets("reestr").Cells(i, 4) <> 0
        name1.AddItem Sheets("reestr").Cells(i, 4)
        i = i + 1
    Loop

    remont.List = Array("ТО-1", "ТО-2", "ТО-3", "ТО-4", "ТР-1", "ТР-2", "ТР-3", "СР", "КР", "ВП", "СП", "Ревизия")
    reshenie.List = Array("Р", "У", "Г", "Д")


    'списки фамилий
    Set Dic = CreateObject("Scripting.Dictionary")
    Populate fio1, ['Журнал ИБ'!K5], Dic
    Populate fiosklad1, ['Журнал ИБ'!L5], Dic
    Populate fiosklad2, ['Журнал ИБ'!R5], Dic
    Populate fio2, ['Журнал ИБ'!S5], Dic
    Populate ceh1, ['Журнал ИБ'!Q5], Dic
    Populate ceh2, ['Журнал ЗС'!H5], Dic
    Populate fio3, ['Журнал ИБ'!I5], Dic
    Populate fio4, ['Журнал ЗС'!J5], Dic
    Populate fio5, ['Журнал ЗС'!N5], Dic
    Populate fiosklad5, ['Журнал ЗС'!O5], Dic
    Set Dic = Nothing
End Sub
Private Sub Populate(ByRef ctrl As Control, ByRef Cell As Range, ByRef Dic As Object)
    Dim arr As Variant
    With Cell.Parent
        arr = .Range(Cell, .Cells(.Rows.Count, Cell.Column).End(xlUp))
    End With
    If IsArray(arr) Then
        With Dic
            .RemoveAll
            For i = LBound(arr) To UBound(arr)
                .Item(arr(i, 1)) = 1
            Next
            ctrl.List = .Keys
        End With
    Else
        ctrl.List = Array(arr)
    End If
End Sub

[/vba]

как-то так
[vba]

Код