Доброго времени суток в файлике 2 листбокса, при инициализации формы должно в листбоксе 1 отображаться значения из ячейки А, а при выборе элементов в листбоксе1 должно отображаться элементы в листбоксе 2 из ячейки В, при этом должны выводиться те элементы, которые соответствуют из листбокса 1. С учетом игнорирования пустых ячеек Например, при выборе дерево в листбоксе2 отображаются 3 элемента - дуб, осина, баобаб получилось у меня сделать но очень криво и жрет много памяти для большого количества ячеек есть может варианты безболезненно исполнить!
Доброго времени суток в файлике 2 листбокса, при инициализации формы должно в листбоксе 1 отображаться значения из ячейки А, а при выборе элементов в листбоксе1 должно отображаться элементы в листбоксе 2 из ячейки В, при этом должны выводиться те элементы, которые соответствуют из листбокса 1. С учетом игнорирования пустых ячеек Например, при выборе дерево в листбоксе2 отображаются 3 элемента - дуб, осина, баобаб получилось у меня сделать но очень криво и жрет много памяти для большого количества ячеек есть может варианты безболезненно исполнить!Asretyq
Private Sub ListBox1_Click() ListBox2.Clear For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) = ListBox1.Text Then ListBox2.AddItem Cells(r, 1).Offset(0, 1) Next r End Sub
Private Sub UserForm_Initialize() For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) <> "" Then ListBox1.AddItem Cells(r, 1).Value Next r End Sub
[/vba]
[vba]
Код
Private Sub ListBox1_Click() ListBox2.Clear For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) = ListBox1.Text Then ListBox2.AddItem Cells(r, 1).Offset(0, 1) Next r End Sub
Private Sub UserForm_Initialize() For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(r, 1) <> "" Then ListBox1.AddItem Cells(r, 1).Value Next r End Sub
Private C_is As Object Private Sub ListBox1_Click() Dim Key As String ListBox2.Clear Key = ListBox1.Value If C_is.Exists(Key) Then Z = Split(C_is.Item(Key), ";") For i = 0 To UBound(Z) ListBox2.AddItem Z(i) Next
End If
End Sub
Private Sub UserForm_Activate() Dim Key As String ListBox1.Clear If C_is Is Nothing Then Set C_is = CreateObject("scripting.dictionary") Else C_is.RemoveAll End If dx = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row) For n = 1 To UBound(dx) If dx(n, 1) <> "" Then Key = dx(n, 1) If Key <> "" Then If C_is.Exists(Key) Then C_is.Item(Key) = C_is.Item(Key) & ";" & dx(n, 2) Else C_is.Item(Key) = dx(n, 2) ListBox1.AddItem Key End If End If
Private C_is As Object Private Sub ListBox1_Click() Dim Key As String ListBox2.Clear Key = ListBox1.Value If C_is.Exists(Key) Then Z = Split(C_is.Item(Key), ";") For i = 0 To UBound(Z) ListBox2.AddItem Z(i) Next
End If
End Sub
Private Sub UserForm_Activate() Dim Key As String ListBox1.Clear If C_is Is Nothing Then Set C_is = CreateObject("scripting.dictionary") Else C_is.RemoveAll End If dx = Range("A2:B" & Cells(Rows.Count, 1).End(xlUp).Row) For n = 1 To UBound(dx) If dx(n, 1) <> "" Then Key = dx(n, 1) If Key <> "" Then If C_is.Exists(Key) Then C_is.Item(Key) = C_is.Item(Key) & ";" & dx(n, 2) Else C_is.Item(Key) = dx(n, 2) ListBox1.AddItem Key End If End If