Question

使用宏或公式，有没有办法实现以下Office 365公式的结果？

=FILTER(B:B,A:A = "x")

如果同一行上的 Column B 的值为 Column A，它所做的是从 x 获取所有值。

我的电脑有 Office 365，但我使用的电脑只有 Office Pro Plus 2019。当我需要这个功能时，我不得不使用我的电脑，我已经厌倦了，也许它也可以在 Office Pro Plus 2019 上使用公式或宏来完成？

Answer 1

使用：

=IFERROR(INDEX($B$1:$B$100,AGGREGATE(15,7,ROW($A$1:$A$100)/($A$1:$A$100="x"),ROW($ZZ1))),"")

请注意使用设置的范围而不是完整的列。这是故意完成的，这是一个数组公式，它将对放置的每个单元格进行大量计算。将范围限制到数据集会加快速度。

将其放在输出的第一个单元格中并向下复制，直到返回空白。

Answer 2

试试这个过滤函数的 UDF：

Function FILTER_HA(Where, Criteria, Optional If_Empty) As Variant
  Dim Data, Result
  Dim i As Long, j As Long, k As Long
  'Create space for the output (same size as input cells)
  With Application.Caller
    i = .Rows.Count
    j = .Columns.Count
  End With
  'Clear
  ReDim Result(1 To i, 1 To j)
  For i = 1 To UBound(Result)
    For j = 1 To UBound(Result, 2)
      Result(i, j) = ""
    Next
  Next
  'Count the rows to show
  For i = 1 To UBound(Criteria)
    If Criteria(i, 1) Then j = j + 1
  Next
  'Empty?
  If j < 1 Then
    If IsMissing(If_Empty) Then
      Result(1, 1) = CVErr(xlErrNull)
    Else
      Result(1, 1) = If_Empty
    End If
    GoTo ExitPoint
  End If
  'Get all data
  Data = Where.Value
  'Copy the rows to show
  For i = 1 To UBound(Data)
    If Criteria(i, 1) Then
      k = k + 1
      For j = 1 To UBound(Data, 2)
        Result(k, j) = Data(i, j)
      Next
    End If
  Next
  'Return the result
ExitPoint:
  FILTER_HA = Result
End Function

Answer 3

我有一些空闲时间，我最近对用户定义的函数感兴趣，所以我决定制作我自己的版本，我想象的会是这样。我在开头说它不好，而且太长，但它有效！

Function JOINIF(ByRef IfRange As Range, ByVal Criteria As String, Optional JoinRange As Range, Optional Delimeter As String = ",") As String
    'IfRange is the range that will be evaluated by the Criteria
    
    'Criteria is a logical test that can be applied to a cell value.
    'Examples of Criteria: "=Steve", ">100", "<>Toronto", "<=-1"
    
    'JoinRange is the range of values that will be concatenated if the corresponding -
    'IfRange cell meets the criteria. JoinRange can be left blank if the values to be -
    'concatenated are the IfRange values.
    
    'Delimeter is the string that will seperate the concatenated values.
    'Default delimeter is a comma.
    
    Dim IfArr() As Variant, JoinArr() As Variant, OutputArr() As String
    Dim IfArrDim As Integer, JoinArrDim As Integer
    Dim JCount As Long, LoopEnd(1 To 2) As Long
    Dim MeetsCriteria As Boolean, Expression As String
    Dim Regex As Variant, Matches As Variant
    
'PARSING THE CRITERIA
    'Add Regular Expressions as a VBA referrence
    AddRef ThisWorkbook, "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}", "VBScript_RegExp_55"
    Set Regex = CreateObject("VBScript.RegExp")
    Regex.Pattern = "[=<>]+"
    'Looking for comparison operators
    Set Matches = Regex.Execute(Criteria)
    If Matches.Count = 0 Then
        'If no operators found, assume default "Equal to"
        If Not IsNumeric(Criteria) Then
            'Add quotation marks to allow string comparisons
            Criteria = "=""" & Criteria & """"
        End If
    Else
        If Not IsNumeric(Replace(Criteria, Matches(0), "")) Then
            Criteria = Matches(0) & """" & Replace(Criteria, Matches(0), "") & """"
        End If
        'Add quotation marks to allow string comparisons
    End If
    
    'Default option for optional JoinRange input
    If JoinRange Is Nothing Then Set JoinRange = IfRange
    
'DIMENSIONS
    'Filling the arrays
    If IfRange.Cells.Count > 1 Then
        IfArr = IfRange.Value
        IfArrDim = Dimensions(IfArr)
    Else
        ReDim IfArr(1 To 1)
        IfArr(1) = IfRange.Value
        IfArrDim = 1
    End If
    If JoinRange.Cells.Count > 1 Then
        JoinArr = JoinRange.Value
        JoinArrDim = Dimensions(JoinArr)
    Else
        ReDim JoinArr(1 To 1)
        JoinArr(1) = JoinRange.Value
        JoinArrDim = 1
    End If
    
    'Initialize the Output array to the smaller of the two input arrays.
    ReDim OutputArr(IIf(IfRange.Cells.Count < JoinRange.Cells.Count, IfRange.Cells.Count - 1, JoinRange.Cells.Count - 1))
    
'DEFINING THE LOOP PARAMETERS
    'Loop ends on the smaller of the two arrays
    If UBound(IfArr) > UBound(JoinArr) Then
        LoopEnd(1) = UBound(JoinArr)
    Else
        LoopEnd(1) = UBound(IfArr)
    End If
    If IfArrDim = 2 Or JoinArrDim = 2 Then
        If Not (IfArrDim = 2 And JoinArrDim = 2) Then
            'mismatched dimensions
            LoopEnd(2) = 1
        ElseIf UBound(IfArr, 2) > UBound(JoinArr, 2) Then
            LoopEnd(2) = UBound(JoinArr, 2)
        Else
            LoopEnd(2) = UBound(IfArr, 2)
        End If
    End If
    
'START LOOP
    If IfArrDim = 1 Then
        For i = 1 To LoopEnd(1)
            If IsNumeric(IfArr(i)) And IfArr(i) <> "" Then
                Expression = IfArr(i) & Criteria
            Else
                'Add quotation marks to allow string comparisons
                Expression = """" & IfArr(i) & """" & Criteria
            End If
            
            MeetsCriteria = Application.Evaluate(Expression)
            
            If MeetsCriteria Then
                If JoinArrDim = 1 Then
                    OutputArr(JCount) = CStr(JoinArr(i))
                Else
                    OutputArr(JCount) = CStr(JoinArr(i, 1))
                End If
                JCount = JCount + 1
            End If
        Next i
    Else
        For i = 1 To LoopEnd(1)
            For j = 1 To LoopEnd(2)
                If IsNumeric(IfArr(i, j)) And IfArr(i, j) <> "" Then
                    Expression = IfArr(i, j) & Criteria
                Else
                    'Add quotation marks to allow string comparisons
                    Expression = """" & IfArr(i, j) & """" & Criteria
                End If
                
                MeetsCriteria = Application.Evaluate(Expression)
                
                If MeetsCriteria Then
                    If JoinArrDim = 1 Then
                        OutputArr(JCount) = CStr(JoinArr(i))
                    Else
                        OutputArr(JCount) = CStr(JoinArr(i, j))
                    End If
                    JCount = JCount + 1
                End If
            Next j
        Next i
    End If

'END LOOP
    ReDim Preserve OutputArr(JCount + 1 * (JCount > 0))
    JOINIF = Join(OutputArr, Delimeter)
End Function
Private Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String)
    'Credit for this Sub goes to the great @hennep from StackOverflow
    Dim i As Integer
    On Error GoTo EH
    With wbk.VBProject.References
        For i = 1 To .Count
            If .Item(i).Name = sRefName Then
               Exit For
            End If
        Next i
        If i > .Count Then
           .AddFromGuid sGuid, 0, 0 
           ' 0,0 should pick the latest version installed on the computer
        End If
    End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
    Resume EX
    Resume ' debug code
End Sub
Private Function Dimensions(var As Variant) As Long
    'Credit goes to the great Chip Pearson, chip@cpearson.com, www.cpearson.com
    On Error GoTo Err
    Dim i As Long, tmp As Long
    While True
        i = i + 1
        tmp = UBound(var, i)
    Wend
Err:
    Dimensions = i - 1
End Function

使用示例：

将 IfRange 和 JoinRange 分开

IfRange 作为 JoinRange

Answer 4

您可以尝试以下 udf（示例调用：FILTER2(A1:A100,B1:B100)），其中包含以下棘手的步骤：

a) 评估一般条件 (=If(A1:A100="x",Row(A1:A100),"?") 作为表格 Excel 公式并将所有有效行号分配给数组 x（用“？”字符串标记其余部分），
b) 过滤掉所有“？”元素
c) 对受益于 advanced restructuring features of Application.Index() 的数据列应用 x

Public Function Filter2(rng1 As Range, rng2 As Variant, Optional ByVal FilterID As String = "x")
    Dim a As String: a = rng1.Address(False, False, External:=True)
    'a) get all valid row numbers (rng1)
    Dim myformula As String: myformula = "if(" & a & "=""" & FilterID & """,row(" & a & "),""?"")"
    Dim x: x = Application.Transpose(Evaluate(myformula))
    'b) filter out invalid "?" elements
    x = VBA.Filter(x, "?", False)
    'c) apply x upon data column (rng2)
    If UBound(x) > -1 Then Filter2 = Application.Index(rng2, Application.Transpose(x), 1)
End Function

注意 2019/MS 365 版本之前的函数调用需要输入为数组公式 (Ctrl+Shift+Enter)。

该函数采用一列（范围）参数。

非办公室 365 上的 FILTER 功能的替代方案

4 个答案: