Question

再次欢迎社区，

在我得到你的最后Problem的帮助之后，我希望以更有效的方式重新编写整个代码，我想再问两个关于同一个项目的问题。

（1）我想在我的列表框 CGList1 中实现一个实时过滤器，它连接到文本框 SearchCGList1 。只要有人在文本框中输入内容，就应该调整列表框中的结果。我在您的网站上找到了这个Article，以及外部网页上的第3条。但是，由于我的技能非常有限，我无法正确地适应它。更晚些时候。

（2）来自同一个列表框 CGList1 的多个项目已经通过一个按钮（就像一个零食一样）转移到第二个列表框 CGList2 ，我想将它们保存在我的工作表 Meta DB 的相同单元格（范围“BM”）中。对于这个问题，我还广泛使用了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：

要保存工作表“Meta DB”中范围BM中CGList2的多个选项，我玩弄了很多，我的最后一次尝试是：

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

使用带数组公式的辅助列。

因此，如果您说a1：a10中的第一个列表框中有数据，并且此列表框中的选择位于D1中，则第二个完整列表框选项位于B1：B10中，但未使用，则在E1中：E10 ，我将以下数组公式填充，因此您将从辅助列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来获取数组公式。

VBA Live-filter列表框通过文本框＆amp;从一个单元格中的列表框中保存多个选项

1 个答案: