VBA Live-фильтр ListBox с помощью текстового поля и сохранить множественный выбор из выпадающего списка в одной ячейке

Question

снова здравствуйте сообщества,

После того как я получил так много помощи от вас с моим последним Problem, что promted меня переделать весь код в более эффективно, я хотел бы задать еще два вопроса относительно того же Проекта.

(1) Я хотел бы реализовать живой фильтр в моем ListBox CGList1, который связан с текстовым полем SearchCGList1. Всякий раз, когда кто-то вводит текстовое поле, результаты в списке должны быть скорректированы. Я нашел этот Article на вашем веб-сайте, а также эту статью 3 на внешней веб-странице. Однако из-за моих очень ограниченных навыков я не смог его правильно адаптировать. Позднее.

(2) После того, как несколько элементов из одной и той же ListBox CGList1 были переданы на второй ListBox CGList2 с помощью кнопки (которая работает как лечить), я хотел бы сохранить их в той же камере (диапазон «BM») на моем листе Meta DB. Для этой проблемы я также широко использовал Google и пытался адаптировать результаты (см. Ссылки ниже) для моего кода - без успеха.

Надеюсь, что пациенты из вас могут помочь мне снова, зная, что я стараюсь учиться как можно больше. Моя проблема в том, что для многих вещей я просто не знаю, что искать.

Мой предварительный код для задачи 1:

CGList1 и CGList2 нет кода. Они заполняются в Userform_Initialize подразделам через:

'Fill Material Groups Listbox1 dynamically 
Dim cell As Range 
Dim rng As Range 

With ThisWorkbook.Sheets("Commodity Groups") 
    'Range to 500 in order to allow for further additions 
    Set rng = .Range("A2", .Range("A500").End(xlUp)) 
End With 

Me.CGList1.ColumnWidths = "20;80" 


For Each cell In rng.Cells 
'Filter out blanks 
If cell <> "" Then 
    With Me.CGList1 
     .AddItem cell.value 
     .List(.ListCount - 1, 1) = cell.Offset(0, 1).value 
    End With 
End If 
Next cell 

Я не могу просто использовать .AddItem и затем процеживают через колонки, как вы найдете во многих примерах в Интернете, поскольку она должна быть динамичной, и есть много пробелов между ними элементы выбора на Рабочем листе.

Кнопки:

Private Sub addCGbutton_Click() 

For i = 0 To CGList1.ListCount - 1 
    If CGList1.Selected(i) = True Then 
     'Copy only CG Name, not respective number/letter combination (only more work to cut out when working with it later) 
     CGList2.AddItem CGList1.List(i, 1) 
    End If 
Next i 

End Sub 

'Delete selected Commodity Groups from List 2 for re-selection 
Private Sub delCGbutton_Click() 

Dim counter As Integer 
counter = 0 

For i = 0 To CGList2.ListCount - 1 
    If CGList2.Selected(i - counter) Then 
     CGList2.RemoveItem (i - counter) 
     counter = counter + 1 
    End If 
Next i 

End Sub 

После долгих проб и неудачи пытаются адаптировать подходы, связанные с другими людьми, я пытался что-то более простое:

Private Sub SearchCGList1_Change() 

'Only show with textbox matching items in CGList1 (filter) 

Dim strSQL As String 

strSQL = "SELECT fieldname FROM table WHERE fieldname = " 
strSQL = strSQL & "'" & Me!SearchCGList1 & "*'" 
strSQL = strSQL & " ORDER BY fieldname;" 

Me!SearchCGList1.RowSource = strSQL 

End Sub 

Но без успеха.

Что касается задачи 2:

Чтобы сохранить множественный выбор из CGList2 в Range BM на рабочий лист «Мета DB», я играл вокруг много, и моя последняя попытка была:

Save multiple selections from Commodity Group List 2 to the same cell in Excel 
Dim listItems As String, c As Long 

With CGList2 
    For c = 0 To .ListCount - 1 
     If .Selected(c) Then listItems = listItems & .List(c) & ", " 
    Next c 
End With 

Range("BM") = Left(listItems, Len(listItems) - 2) 

Обычно все другие мои записи UserForm сохраняются с помощью кнопки одной команды в следующем фьюжн:

Private Sub CommandButton21_Click() 
'Application.ScreenUpdating = False 


'Define all relevant WBs we will be working with 
Dim wbInput As Workbook 
Dim wb As Workbook 
Set wb = ActiveWorkbook 
Dim ws As Worksheet 
Set ws = wb.Worksheets("Meta DB") 
Dim LastRow As Long 


'Save Userform Inputs 
With ws 
    .Activate 
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).row + 1 
    . 
    . 
    Range("BK" & LastRow).value = Me.payinfo90 
    Range("BL" & LastRow).value = Me.payinfo90more 
    'Risk Management - Residual Information 
    Range("BM" & LastRow).value = Me.CGList2 
    Range("BN" & LastRow).value = Me.suppsince 
    . 
    . 
End With 

End Sub 

Опять же, я благодарю всех, кто нашел время, чтобы прочитать мой пост и ответить советы по улучшению.

У каждого прекрасный день.

Answer 1

Использование вспомогательной колонки с формулой массива.

Итак, если вы указали, что у вас есть данные для 1-го списка в формате a1: a10, а выбор из этого списка помещен в D1, 2-й полный список выбора находится в B1: B10, но не используется, а затем в E1: E10, я имею следующую формулу массива заполнены вниз, так что вы бы заселить 2-й ListBox выключить хелперов колонке E.

Начиная с =INDEX($B$1:$B$10,SMALL(IF(LEFT($B$1:$B$10,LEN($D$1))=$D$1,ROW($B$1:$B$10),""),ROWS($E$1:$E1)),1)

Содержит =INDEX($B$1:$B$10,SMALL(IF(NOT(ISERR(SEARCH($D$1,$B$1:$B$10))),ROW($B$1:$B$10)),ROWS($E$1:E1)),1)

вы должны нажать CTRL SHIFT и ENTER для формулы массива.