Добрый день Есть listbox2, где выбираются категории Как можно внести в listbox1 список только тех значений из ячейки B, которым соответствует категория в ячейке А.
Добрый день Есть listbox2, где выбираются категории Как можно внести в listbox1 список только тех значений из ячейки B, которым соответствует категория в ячейке А.Asretyq
При выборе из listbox2 "красный" в listbox1 появляются значения - 107, 88, 33 При выборе из listbox2 "белый" в listbox1 появляются значения - 100, двойной слой ну соответственно и для других цветов то, что соответствует напротив ячейки
При выборе из listbox2 "красный" в listbox1 появляются значения - 107, 88, 33 При выборе из listbox2 "белый" в listbox1 появляются значения - 100, двойной слой ну соответственно и для других цветов то, что соответствует напротив ячейкиAsretyq
Me.ListBox1.Clear For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(i, 1).Value = Me.ListBox2.Value Then Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Cells(i, 2).Value End If Next i
End Sub
[/vba]
А чем прямой перебор не устраивает?[vba]
Код
Private Sub ListBox2_Change()
Dim i As Integer
Me.ListBox1.Clear For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row If Cells(i, 1).Value = Me.ListBox2.Value Then Me.ListBox1.AddItem Me.ListBox1.List(Me.ListBox1.ListCount - 1, 0) = Cells(i, 2).Value End If Next i
Не, ну если в "боевом" файле десятки тысяч строк, например, то есть смысл подумать над использованием AdvancedFilter и CpecialCells, но для сотни-другой и перебор сойдёт.
Не, ну если в "боевом" файле десятки тысяч строк, например, то есть смысл подумать над использованием AdvancedFilter и CpecialCells, но для сотни-другой и перебор сойдёт.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Private Sub ListBox2_Change() r0_ = 1 n_ = Cells(Rows.Count, 1).End(3).Row - r0_ + 1 ar = Cells(r0_, 1).Resize(n_, 2) z_ = Me.ListBox2.Value With CreateObject("Scripting.Dictionary") For i = 1 To n_ If ar(i, 1) = z_ Then aaa = .Item(ar(i, 2)) End If Next i Me.ListBox1.List = .keys End With End Sub
[/vba]
Вариант с уникальными значениями столбца В [vba]
Код
Private Sub ListBox2_Change() r0_ = 1 n_ = Cells(Rows.Count, 1).End(3).Row - r0_ + 1 ar = Cells(r0_, 1).Resize(n_, 2) z_ = Me.ListBox2.Value With CreateObject("Scripting.Dictionary") For i = 1 To n_ If ar(i, 1) = z_ Then aaa = .Item(ar(i, 2)) End If Next i Me.ListBox1.List = .keys End With End Sub
StoTisteg, в моем случае сойдет, спасибо _Boroda_, подключил библиотеку Microsoft scripting runtime, не хочет работать, может другая библиотека задействована?
StoTisteg, в моем случае сойдет, спасибо _Boroda_, подключил библиотеку Microsoft scripting runtime, не хочет работать, может другая библиотека задействована?Asretyq
_Boroda_, не прописан, я скачал файл ваш, переменные прописал стало работать может файл косячный, файл еще не сохраняет изменения)) в общем перенесу код, Спасибо за помощь)
_Boroda_, не прописан, я скачал файл ваш, переменные прописал стало работать может файл косячный, файл еще не сохраняет изменения)) в общем перенесу код, Спасибо за помощь)Asretyq
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
