Question

一直在处理这个自动过滤代码。它的工作原理很好。如果我在＆＃34; Quotes＆＃34;中使用我的搜索条件替换FilterCriteria它每次都有效。但是，当尝试在FilterCriteria中传递数字时，每次都无法在我的范围内找到任何内容（A：D ONLY！）。它找到Colums 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的任何数字运行AutoFilter时，它无法提供任何已过滤的数据。如我所说，我很难过，如果我在AutoFilter行中放置了我想要的确切值，它将返回过滤后的数据。

非常肯定这一行是我的问题/问题： My_Range.AutoFilter字段：= PickCol，Criteria1：=＆＃34; = ＆＃34; ＆安培; FilterCriteria＆amp; ＆＃34; ＆＃34;

任何想法？

我想现在我必须弄清楚如何真正做到这一点。在工作表上正确使用自动过滤器可以正常工作。如果我必须这样做，我认为文章显示然后我必须添加4个列，我必须在生成此列表的表单上重写SaveLog代码中的代码。听起来我需要大幅增加代码的大小。对于像我这样的新手，我在这一点上肯定不堪重负。

Answer 1

此问题的核心是您不能将文本比较运算符与Numbers一起使用。 当您将通配符*添加到搜索条件时，您将强制执行文本比较。

如果您希望使用数字和文本并选择变量列，则需要添加一些检查以正确构建标准。这将涉及在选择数字列时删除*。要记住的主要事情是每种数据类型只有一些可用的过滤器。要检查这些内容，请点击常规过滤器菜单中的箭头，查看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），您将开始覆盖其他列。

Answer 2

它不漂亮，我确信这段代码有很大的改进空间，但这就是我要使用的内容。我将“FilterCriteria”变暗为Variant，并使用以下Select-Case例程替换紧跟在“PickCol”和“FilterCriteria”输入框之后的单行：

    '  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' Determines whether "FilterCriteria" is Date, Numerical or text input
    Select Case PickCol
       Case 1
         ' "PickCol" - Column "A" (1) is Date
           ' Define for Numeric
             My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria

       Case 2 To 4
         ' "PickCol" - Column "B:D" (2-4) Are Numerical
             ' Define for Numeric
           My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria
           ' This column CAN have mixed Numeric and Text data. So-> Evaluate that
             If IsNumeric(FilterCriteria) Then
             ' Define for Numeric
                My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria
             Else
             ' Redefine for Text instead
                My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"
             End If
       Case Else
         ' "PickCol" - Column "E:G" (5-7) Are Text
             ' Define for Text
                My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"
       End Select
    '  ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

像我说的那样。 “它可能不太漂亮，但确实有效。”

感谢@Byron的建议

这允许在E：G中输入通配符（部分），尽管A：D必须与写入完全相同。我仍然必须捕获输入的不存在的数据的错误或它崩溃。与其余部分相比，这是一小步。在工作中给我另一个饼干。因为我很饿，所以也很好。 LOL

AutoFilter在过滤视图中看不到数值数据（多值）

2 个答案: