Добрый день! В файле-примере 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] Оба варианта формируют список "сквозняком". Как заставить их работать на благо общества, но не показывать повторы и игнорировать пустые строки?
Добрый день! В файле-примере 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
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]
[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
Словарь , полезная штука для отбора уникальных значений, например. Я лично предпочитаю раннее связывание, тогда не надо всю его модель в голове держать... Хотя её в общем-то немного.
Словарь , полезная штука для отбора уникальных значений, например. Я лично предпочитаю раннее связывание, тогда не надо всю его модель в голове держать... Хотя её в общем-то немного.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Сообщение отредактировал StoTisteg - Четверг, 06.09.2018, 10:07
StoTisteg, Я, так понимаю, что на больших объемах словари работают быстрее? Мне тут формочку надо будет сделать, а там под 800 тысяч строк... Вот думаю как ускорить.
StoTisteg, Я, так понимаю, что на больших объемах словари работают быстрее? Мне тут формочку надо будет сделать, а там под 800 тысяч строк... Вот думаю как ускорить.AVI
StoTisteg, У меня файлик с перечнем. Сейчас там работает фильтр через макрос, стыренный на соседнем ресурсе. Смысл в том, что макрос после введения параметров поиска в нужную ячейку, сворачивает строки, которые не удовлетворяют параметрам поиска. В результат поиска может вываливаться и 1 строка, и несколько тысяч. Вот это сворачивание на медленных компах существенно подвисает. Я хочу отказаться от сворачивания и результат поиска просто выводился на листбокс в юзерформе.
StoTisteg, У меня файлик с перечнем. Сейчас там работает фильтр через макрос, стыренный на соседнем ресурсе. Смысл в том, что макрос после введения параметров поиска в нужную ячейку, сворачивает строки, которые не удовлетворяют параметрам поиска. В результат поиска может вываливаться и 1 строка, и несколько тысяч. Вот это сворачивание на медленных компах существенно подвисает. Я хочу отказаться от сворачивания и результат поиска просто выводился на листбокс в юзерформе.AVI
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
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