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

Вход

Регистрация

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

 

= Мир MS Excel/Список без повторов - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Список без повторов (Макросы/Sub)
Список без повторов
Паштет Дата: Воскресенье, 24.06.2018, 13:02 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 1 ±
Замечаний: 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
 
Ответить
СообщениеДоброго времени суток.
Вроде и избитая тема. Нужен список к 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]
При первом запуске формы все работает отлично, но после записи данных и перезагрузки формы ругается на не совместимый тип данных. В чем дело понять не могу.

Автор - Паштет
Дата добавления - 24.06.2018 в 13:02
RAN Дата: Воскресенье, 24.06.2018, 13:15 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4831
Репутация: 968 ±
Замечаний: 0% ±

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


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеФорму из самой себя закрыть можно, a вот открыть - нет.

Автор - RAN
Дата добавления - 24.06.2018 в 13:15
krosav4ig Дата: Воскресенье, 24.06.2018, 14:35 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1648
Репутация: 689 ±
Замечаний: 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]
К сообщению приложен файл: 0906726.xlsm(63.2 Kb)


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Воскресенье, 24.06.2018, 14:36
 
Ответить
Сообщениекак-то так
[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]

Автор - krosav4ig
Дата добавления - 24.06.2018 в 14:35
Паштет Дата: Понедельник, 25.06.2018, 12:34 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 64
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Спасибо! Все работает!
 
Ответить
СообщениеСпасибо! Все работает!

Автор - Паштет
Дата добавления - 25.06.2018 в 12:34
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Список без повторов (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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