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

Вход

Регистрация

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

 

= Мир MS Excel/Combobox без повторов с условем - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Combobox без повторов с условем (Макросы/Sub)
Combobox без повторов с условем
AVI Дата: Среда, 05.09.2018, 18:54 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
В файле-примере 2 варианта формирования комбобоксов
[vba]
Код
Private Sub UserForm_Initialize()
    With UserForm1
        .ComboBox1.RowSource = "Таблица2[Столбец5]"
        .Show
    End With
End Sub
[/vba]
и
[vba]
Код
Sub fffff()
    Dim ar, i
    With UserForm1
    .ComboBox2.Clear
    If .ComboBox1.Value = "" Then Exit Sub
    ar = Range("Таблица2")
    For i = 1 To UBound(ar)
        If ar(i, 5) = .ComboBox1.Value Then
            .ComboBox2.AddItem ar(i, 6)
        End If
    Next i
    End With
End Sub
[/vba]
Оба варианта формируют список "сквозняком". Как заставить их работать на благо общества, но не показывать повторы и игнорировать пустые строки?
К сообщению приложен файл: _Microsoft_Exce.xlsm(21.9 Kb)


Сообщение отредактировал AVI - Среда, 05.09.2018, 18:55
 
Ответить
СообщениеДобрый день!
В файле-примере 2 варианта формирования комбобоксов
[vba]
Код
Private Sub UserForm_Initialize()
    With UserForm1
        .ComboBox1.RowSource = "Таблица2[Столбец5]"
        .Show
    End With
End Sub
[/vba]
и
[vba]
Код
Sub fffff()
    Dim ar, i
    With UserForm1
    .ComboBox2.Clear
    If .ComboBox1.Value = "" Then Exit Sub
    ar = Range("Таблица2")
    For i = 1 To UBound(ar)
        If ar(i, 5) = .ComboBox1.Value Then
            .ComboBox2.AddItem ar(i, 6)
        End If
    Next i
    End With
End Sub
[/vba]
Оба варианта формируют список "сквозняком". Как заставить их работать на благо общества, но не показывать повторы и игнорировать пустые строки?

Автор - AVI
Дата добавления - 05.09.2018 в 18:54
_Boroda_ Дата: Среда, 05.09.2018, 19:33 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 12958
Репутация: 5330 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
Так нужно?

Private Sub UserForm_Initialize()
    ar = Range("Таблица2[Столбец5]")
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) <> "" Then
                If Not .Exists(ar(i, 1)) Then
                    UserForm1.ComboBox1.AddItem ar(i, 1)
                    aaa = .Item(ar(i, 1))
                End If
            End If
        Next i
    End With
End Sub

Sub fffff()
    Dim ar, i
    With UserForm1
        .ComboBox2.Clear
        cb1_ = .ComboBox1.Value
        If cb1_ = "" Then Exit Sub
        ar = Range("Таблица2[[Столбец5]:[Столбец6]]")
        Set slov = CreateObject("Scripting.Dictionary")
        With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) = cb1_ Then
                If Not .Exists(ar(i, 2)) Then
                UserForm1.ComboBox2.AddItem ar(i, 2)
                aaa = .Item(ar(i, 2))
                End If
            End If
        Next i
        End With
    End With
End Sub
[/vba]
К сообщению приложен файл: 6235342.xlsm(24.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
Так нужно?

Private Sub UserForm_Initialize()
    ar = Range("Таблица2[Столбец5]")
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) <> "" Then
                If Not .Exists(ar(i, 1)) Then
                    UserForm1.ComboBox1.AddItem ar(i, 1)
                    aaa = .Item(ar(i, 1))
                End If
            End If
        Next i
    End With
End Sub

Sub fffff()
    Dim ar, i
    With UserForm1
        .ComboBox2.Clear
        cb1_ = .ComboBox1.Value
        If cb1_ = "" Then Exit Sub
        ar = Range("Таблица2[[Столбец5]:[Столбец6]]")
        Set slov = CreateObject("Scripting.Dictionary")
        With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) = cb1_ Then
                If Not .Exists(ar(i, 2)) Then
                UserForm1.ComboBox2.AddItem ar(i, 2)
                aaa = .Item(ar(i, 2))
                End If
            End If
        Next i
        End With
    End With
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 05.09.2018 в 19:33
AVI Дата: Четверг, 06.09.2018, 03:22 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, Спасибо!!
Опять новое для меня
[vba]
Код
CreateObject("Scripting.Dictionary")
[/vba]
 
Ответить
Сообщение_Boroda_, Спасибо!!
Опять новое для меня
[vba]
Код
CreateObject("Scripting.Dictionary")
[/vba]

Автор - AVI
Дата добавления - 06.09.2018 в 03:22
StoTisteg Дата: Четверг, 06.09.2018, 10:05 | Сообщение № 4
Группа: Авторы
Ранг: Ветеран
Сообщений: 976
Репутация: 82 ±
Замечаний: 0% ±

Excel 2010
Опять новое для меня
Словарь , полезная штука для отбора уникальных значений, например. Я лично предпочитаю раннее связывание, тогда не надо всю его модель в голове держать... Хотя её в общем-то немного.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Четверг, 06.09.2018, 10:07
 
Ответить
Сообщение
Опять новое для меня
Словарь , полезная штука для отбора уникальных значений, например. Я лично предпочитаю раннее связывание, тогда не надо всю его модель в голове держать... Хотя её в общем-то немного.

Автор - StoTisteg
Дата добавления - 06.09.2018 в 10:05
AVI Дата: Среда, 12.09.2018, 09:38 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, А как сделать, что бы еще и по алфавиту расставлялось?
 
Ответить
Сообщение_Boroda_, А как сделать, что бы еще и по алфавиту расставлялось?

Автор - AVI
Дата добавления - 12.09.2018 в 09:38
AVI Дата: Среда, 12.09.2018, 09:40 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
StoTisteg, Я, так понимаю, что на больших объемах словари работают быстрее? Мне тут формочку надо будет сделать, а там под 800 тысяч строк... Вот думаю как ускорить.
 
Ответить
СообщениеStoTisteg, Я, так понимаю, что на больших объемах словари работают быстрее? Мне тут формочку надо будет сделать, а там под 800 тысяч строк... Вот думаю как ускорить.

Автор - AVI
Дата добавления - 12.09.2018 в 09:40
китин Дата: Среда, 12.09.2018, 09:51 | Сообщение № 7
Группа: Модераторы
Ранг: Участник клуба
Сообщений: 5024
Репутация: 798 ±
Замечаний: 0% ±

Excel 2007;Excel 2010
StoTisteg, ссылка битая. у меня не открывает


Не судите строго:я пытаюсь научиться
ЯД 41001877306852/WM R249698041931; Z239672726538
 
Ответить
СообщениеStoTisteg, ссылка битая. у меня не открывает

Автор - китин
Дата добавления - 12.09.2018 в 09:51
AVI Дата: Среда, 12.09.2018, 10:22 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
китин, забавно, я неделю назад открывал)
 
Ответить
Сообщениекитин, забавно, я неделю назад открывал)

Автор - AVI
Дата добавления - 12.09.2018 в 10:22
StoTisteg Дата: Среда, 12.09.2018, 10:23 | Сообщение № 9
Группа: Авторы
Ранг: Ветеран
Сообщений: 976
Репутация: 82 ±
Замечаний: 0% ±

Excel 2010
А так?
[moder]Исправила ссылку выше. Запятая мешала[/moder]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал Pelena - Среда, 12.09.2018, 10:28
 
Ответить
СообщениеА так?
[moder]Исправила ссылку выше. Запятая мешала[/moder]

Автор - StoTisteg
Дата добавления - 12.09.2018 в 10:23
StoTisteg Дата: Среда, 12.09.2018, 10:25 | Сообщение № 10
Группа: Авторы
Ранг: Ветеран
Сообщений: 976
Репутация: 82 ±
Замечаний: 0% ±

Excel 2010
Мне тут формочку надо будет сделать, а там под 800 тысяч строк...
А пользователи в этих 800 тысячах как ориентироваться будут? %)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
Мне тут формочку надо будет сделать, а там под 800 тысяч строк...
А пользователи в этих 800 тысячах как ориентироваться будут? %)

Автор - StoTisteg
Дата добавления - 12.09.2018 в 10:25
StoTisteg Дата: Среда, 12.09.2018, 10:26 | Сообщение № 11
Группа: Авторы
Ранг: Ветеран
Сообщений: 976
Репутация: 82 ±
Замечаний: 0% ±

Excel 2010
А как сделать, что бы еще и по алфавиту расставлялось?
Предварительно сортировать на листе. Ваш К. О. :)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
А как сделать, что бы еще и по алфавиту расставлялось?
Предварительно сортировать на листе. Ваш К. О. :)

Автор - StoTisteg
Дата добавления - 12.09.2018 в 10:26
StoTisteg Дата: Среда, 12.09.2018, 10:27 | Сообщение № 12
Группа: Авторы
Ранг: Ветеран
Сообщений: 976
Репутация: 82 ±
Замечаний: 0% ±

Excel 2010
на больших объемах словари работают быстрее?
Быстрее чего? Быстрее коллекций — это да, обращение непосредственно к элементу быстрее, чем через указатель...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
на больших объемах словари работают быстрее?
Быстрее чего? Быстрее коллекций — это да, обращение непосредственно к элементу быстрее, чем через указатель...

Автор - StoTisteg
Дата добавления - 12.09.2018 в 10:27
AVI Дата: Среда, 12.09.2018, 10:38 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
StoTisteg, У меня файлик с перечнем. Сейчас там работает фильтр через макрос, стыренный на соседнем ресурсе. Смысл в том, что макрос после введения параметров поиска в нужную ячейку, сворачивает строки, которые не удовлетворяют параметрам поиска. В результат поиска может вываливаться и 1 строка, и несколько тысяч. Вот это сворачивание на медленных компах существенно подвисает. Я хочу отказаться от сворачивания и результат поиска просто выводился на листбокс в юзерформе.
 
Ответить
СообщениеStoTisteg, У меня файлик с перечнем. Сейчас там работает фильтр через макрос, стыренный на соседнем ресурсе. Смысл в том, что макрос после введения параметров поиска в нужную ячейку, сворачивает строки, которые не удовлетворяют параметрам поиска. В результат поиска может вываливаться и 1 строка, и несколько тысяч. Вот это сворачивание на медленных компах существенно подвисает. Я хочу отказаться от сворачивания и результат поиска просто выводился на листбокс в юзерформе.

Автор - AVI
Дата добавления - 12.09.2018 в 10:38
AVI Дата: Среда, 12.09.2018, 10:38 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
StoTisteg, это нельзя делать.
 
Ответить
СообщениеStoTisteg, это нельзя делать.

Автор - AVI
Дата добавления - 12.09.2018 в 10:38
_Boroda_ Дата: Среда, 12.09.2018, 10:46 | Сообщение № 15
Группа: Модераторы
Ранг: Местный житель
Сообщений: 12958
Репутация: 5330 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
это нельзя делать.

Льзя
[vba]
Код
Private Sub UserForm_Initialize()
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    ar0 = Range("Таблица2")
    With ActiveSheet.ListObjects("Таблица2").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("Таблица2[[#All],[Столбец5]]")
        .Apply
    End With
    ar = Range("Таблица2[Столбец5]")
    Range("Таблица2") = ar0
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) <> "" Then
                If Not .Exists(ar(i, 1)) Then
                    UserForm1.ComboBox1.AddItem ar(i, 1)
                    aaa = .Item(ar(i, 1))
                End If
            End If
        Next i
    End With
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
это нельзя делать.

Льзя
[vba]
Код
Private Sub UserForm_Initialize()
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    ar0 = Range("Таблица2")
    With ActiveSheet.ListObjects("Таблица2").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("Таблица2[[#All],[Столбец5]]")
        .Apply
    End With
    ar = Range("Таблица2[Столбец5]")
    Range("Таблица2") = ar0
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To UBound(ar)
            If ar(i, 1) <> "" Then
                If Not .Exists(ar(i, 1)) Then
                    UserForm1.ComboBox1.AddItem ar(i, 1)
                    aaa = .Item(ar(i, 1))
                End If
            End If
        Next i
    End With
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 12.09.2018 в 10:46
AVI Дата: Среда, 12.09.2018, 11:01 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 394
Репутация: 7 ±
Замечаний: 0% ±

Excel 2016
_Boroda_, Блин, это не честно)))
Я вбил себе в голову, что сортировать после получения уникальных значений...

Спасибо)))
 
Ответить
Сообщение_Boroda_, Блин, это не честно)))
Я вбил себе в голову, что сортировать после получения уникальных значений...

Спасибо)))

Автор - AVI
Дата добавления - 12.09.2018 в 11:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Combobox без повторов с условем (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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