在 TextBox (ActiveX) 上找到多个值的自动筛选

Question

我的工作表上有一个文本框，以获取其值以用作另一个自动筛选代码的条件。
我已经将该文本框的

MutliLine

属性设置为 True。 如果我复制一个单元格并粘贴到文本框上并按下 Enter，则代码运行正确。
但是 如果复制 multi cells 并粘贴到文本框上并按 Enter 键，那么自动筛选的结果是空的，不会引发任何错误。
我发现这些值已经粘贴在文本框上了。
所以，我需要 Sub

Filter_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

MultiLine

属性只允许文本传递到下一行...也可以粘贴连续的单元格，用行尾分隔符分隔它们的值。您需要提取一个数组，其中包含要在下一步（过滤）中使用的分隔字符串。

所以，尝试下一个方法：

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
       If arr(i) <> "" Then ReDim Preserve ar(ub - i + 1): Exit For
   Next i
   Filt = ar
End Function

事件代码中的分割线应该更改为以下方式：

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