vba - 自动筛选在筛选 View 中看不到数值数据(多个值)

Question

研究这个自动过滤代码已经有一段时间了。就目前而言，它运作良好。如果我在“Quotes”中使用我的搜索条件替换 FilterCriteria，它每次都会起作用。然而，当尝试在 FilterCriteria 中传递数字时，它每次都无法在我的范围内找到任何内容(仅限 A:D!)。它可以很好地找到 E:G 列中的所有文本字段，因为它们都是文本。 A:D 列不返回任何内容。我尝试将 A:D 格式化为文本而不是数字，但过滤时仍然看不到任何内容。希望在最后显示示例范围。

Sub FindProduct()

  'Note: This macro uses the function LastRow at end of Module
  ' Highly moded code from Ron de Bruin

    'To define My_Range
       Dim My_Range As Range
       Dim CalcMode As Long
       Dim ViewMode As Long
       Dim CCount As Long
    'To define New Sheet and Range
       Dim WSNew As Worksheet
    'Use for column and filter data selection
       Dim FilterCriteria As String
       Dim PickCol As String

    'Set filter range on ActiveSheet
       Set My_Range = Range("A1:G" & LastRow(ActiveSheet))
       My_Range.Parent.Select

 '  ************************************
    My_Range.Parent.AutoFilterMode = False
       '  Unprotect sheet, turn off AutoFilter, Show All
          With ActiveSheet
             .Unprotect
             On Error Resume Next
             .ShowAllData
          End With
    '  Code to check if workbook is protected here. Redundant.
 '  ****************************************
     'Turn off ScreenUpdating, Calculation, EnableEvents code here
  '  +++++++++++++++++++++++++++++++++++
       '  Use this to pick a Column to search and your FilterCriteria
       PickCol = InputBox("What Column do you want to search in " & vbCrLf _
       & "(A=1,B=2,C=3,D=4,E=5,F=6,G=7)?" _
       & vbCrLf & vbCrLf, "Select Column to Search")
          '  Input error check
       '  ######################
       FilterCriteria = InputBox("What are you looking for?" _
       & vbCrLf & vbCrLf & "This will work with partial Information.", _
       "Enter Filter Parameter")
          '  Input error check
 '  *********************************************************
    '  Insert PickCol and FilterCriteria variables
    My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"

    'Check if there are not more then 8192 areas (limit of areas that Excel can copy)
    CCount = 0
    On Error Resume Next
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
    On Error GoTo 0
      If CCount = 0 Then
          MsgBox "There are more than 8192 areas:" _
               & vbCrLf & "It is not possible to copy the visible data."
      Else
        '  ***********************************************
           'Delete "Filtered Data" sheet if it exists code here
        '  ***********************************************
        '  ------------------------------
          'Add a new Worksheet
           Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))
           On Error Resume Next
           WSNew.Name = "Filtered Data"
        '  ------------------------------
        '  ///////////////////////////////////////////////////
           'Copy/paste the visible data to the new worksheet
           My_Range.Parent.AutoFilter.Range.Copy
             ' Paste copied range starting at Cell("A2")
             With WSNew.Range("A2")
                 .PasteSpecial Paste:=8
                 .PasteSpecial xlPasteAll
                 .PasteSpecial xlPasteFormats
                 Application.CutCopyMode = False
                 .Select
             End With
        ' ///////////////////////////////////////////////////
        ' *****************************************
          'Adds Formatted Text to Cell ("A1") code here
        ' *****************************************
      End If

    ' Turn off AutoFilter
    My_Range.Parent.AutoFilterMode = False

'  ******************************************************
   'More finishing code here
'  ******************************************************

End Sub

 Function LastRow(Sh As Worksheet)
     On Error Resume Next
     LastRow = Sh.Cells.Find(What:="*", _
                        After:=Sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
     On Error GoTo 0
 End Function

示例数据:

    A        B     C         D          E         F           G
Date Rvd    Qty   File#    P.O.#    Cust Name    Vend Name   Carrier
02/14/15    210   41680    38565    Some Tech    John        DHL
03/08/15    458   17017    38569    Them Guys    Donn        Fedx
03/12/15    350   16736    38541    Some Guys    Teri        UPS
03/24/15    236   42630    38655    Some Tech    John        DHL
04/08/15    458   56985    85693    Them Guys    Donn        Fedx
04/12/15    350   12345    43851    Some Guys    Teri        UPS
04/18/15    838   56685    85693    Them Guys    Donn        Fedx
05/05/15    110   13245    43851    Some Guys    Teri        UPS

无论出于何种原因，当它使用 A:D 的任何数字运行自动筛选时，它都无法提供任何筛选的数据。正如我所说，如果我在自动过滤行中放置我想要的确切值，它将返回过滤后的数据，我被难住了。

很确定这一行是我的问题:My_Range.AutoFilter Field:=PickCol, Criteria1:="="& FilterCriteria & ""

有什么想法吗？

我想现在我必须弄清楚如何真正实现这一点。在纸张上正确使用自动过滤器效果很好。如果我必须按照我认为文章所示的那样进行，那么我必须再添加 4 列，并且我必须重写生成此列表的表单上的 SaveLog 代码中的代码。听起来我需要大幅增加所有代码的大小。对于像我这样的新手来说，此时此刻我肯定不知所措。

Answer 1

此问题的核心是您不能将文本比较运算符与数字一起使用。 当您添加通配符 * 时对于搜索条件，您正在执行文本比较。

如果您希望它能够处理数字和文本并具有可变列选择，您将需要添加一些检查以正确构建条件。这将涉及删除 *当选择数字列时。要记住的主要事情是每种数据类型仅具有某些可用的过滤器。要检查这些，请单击普通过滤器菜单中的箭头以查看 Number Filters 下列出的内容。或Date Filters或Text Filters .

考虑到所有这些，如果您想过滤 Contains 上的那些数字列，您需要将其转换为文本。

根据 comment by @Tim Williams ，您可以使用 Data->Text to Columns 将数字转换为文本特征。如果您知道需要转换哪些范围，则可以使用 VBA 自动执行此步骤。

要使其正常工作所需的最小参数数量似乎是 DataType和FieldInfo 。 FieldInfo是强制转换的重要一环。

Sub ConvertColumnNumberToText()

    Dim rng_column As Range
    For Each rng_column In Range("B:D").Columns
        rng_column.TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 2)
    Next rng_column

End Sub

查看 TextToColumns 的文档看看参数是什么。它一次只能对一列起作用，因此是循环。

此外，多次运行此代码也没有什么坏处，只要它仅在仅包含数字的列上运行即可。如果您不小心在可拆分为列的列(默认情况下包含 TAB)上运行它，您将开始覆盖其他列。