自动筛选在文本框(ActiveX)上找到的多个值

Question

我的工作表上有一个文本框，它的值被用作另一个自动筛选代码的标准。
我将该文本框的MutliLine属性设置为True。如果复制一个单元格并粘贴到文本框上并按Enter键，那么代码将正确运行。
如果复制了多个单元格并粘贴在文本框上并按Enter，那么自动筛选的结果是没有任何错误。
我发现值已经粘贴在文本框上了。
所以，我需要SubFilter_WoNumber接受文本框上的所有值作为标准。
事先，非常感谢您的帮助。
这是表单模块的代码:

Private Sub TextBox3_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = Asc(vbCr) Then                 'Run code after press EnterKey
If Me.TextBox3.Value <> "" Then
crit_Filter = TextBox3.Value        '"crit_Filter" is a public variable
Filter_WoNumber
End If
End If
End Sub

，这是AutoFilter的主要子元素:

Public crit_Filter As String
Sub Filter_WoNumber()
Dim ws As Worksheet, lRow As Long, lcol_n As Long, lastcol As String, rng As Range

Set ws = ActiveSheet
lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row                      'Last_Row on Column "A"
lcol_n = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column          'Last_Column number on Row_2
lastcol = Split(Cells(1, lcol_n).Address(True, False), "$")(0)      'Letter of Last_Column
Set rng = ws.Range("A2:" & lastcol & lRow)                              'Source Range to apply Filter on it
If Not ws.AutoFilterMode Then rng.AutoFilter                            'Set AutoFilter if not already set
ws.AutoFilter.ShowAllData

rng.AutoFilter field:=1, Criteria1:=crit_Filter, Operator:=xlFilterValues
End Sub 

Answer 1

MultiLineproperty只允许文本在下一行传递…还可以粘贴连续的单元格，用行结束分隔符分隔它们的值。您需要从数组中提取

包含将在下一个(过滤)步骤中使用的分隔字符串。那么，试试下面的方法:

1. 修改公共变量声明:

Public crit_Filter As Variant

2. 修改文本框事件代码:

Private Sub TextBox3_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = Asc(vbCr) Then                              'Run code after press EnterKey
If Me.TextBox3.Value <> "" Then
crit_Filter = Split(TextBox3.Text, vbCrLf) '"crit_Filter" is a public (array) variable
Filter_WoNumber
End If
End If
End Sub

没有测试，但应该可以，我想…

:

我测试了上面的代码部分，它像我想象的那样工作，除了在文本框中粘贴多范围后，还插入了一个额外的空行。因此，下一个函数能够修剪它:

Function Filt(arr) As Variant
Dim ar, ub As Long, i As Long, k As Long
ar = arr: ub = UBound(ar)
For i = UBound(arr) To 0 Step -1
k = k + 1
If arr(i) <> "" Then ReDim Preserve ar(ub - k + 1): Exit For
Next i
Filt = ar
End Function

事件代码中的分割行应按以下方式更改:

crit_Filter = Filt(Split(TextBox3.Text, vbCrLf)) '"crit_Filter" is a public (array) variable

第二个编辑:

要过滤复制区域(从文本框)中的所有空单元格，请使用下一个函数:

Function filtEmpty(arr) As Variant 'filters all empty elements
Dim ar, i As Long, k As Long
ReDim ar(UBound(arr))
For i = LBound(arr) To UBound(arr)
If arr(i) <> "" Then ar(k) = arr(i): k = k + 1
Next i
If k > 0 Then ReDim Preserve ar(k - 1)

filtEmpty = ar
End Function

当然，而不是:

你应该使用:

PP_9