使用宏或公式，是否有一种方法可以实现Office 365以下公式的结果？
=FILTER(B:B,A:A = "x")
它的作用是从B列获取所有值，如果同一行上的A列具有x的值。
我的电脑有Office 365，但我正在使用的那个只有Office Pro Plus 2019。当我需要该功能时，我不得不使用我的电脑，而且我已经厌倦了，也许可以使用公式或宏在Office Pro Plus 2019上完成它吗？
5个回答
7
使用：
=IFERROR(INDEX($B$1:$B$100,AGGREGATE(15,7,ROW($A$1:$A$100)/($A$1:$A$100="x"),ROW($ZZ1))),"")
注意使用集合范围而不是全部列，这是有意为之的。由于这是一个数组公式，每个单元格都需要进行大量计算，将范围限制在数据集上可以加快速度。 将此放入输出的第一个单元格中，向下复制直到返回空白。
- Scott Craner
1
你可以尝试以下的自定义函数（示例调用：
该函数假设参数为单列（范围）。
FILTER2(A1:A100,B1:B100)），包含以下棘手的步骤：
- a) 将一般条件（
=If(A1:A100="x",Row(A1:A100),"?"）作为表格Excel公式进行评估，并将所有有效行号分配给数组x（通过"?"字符串标记其余部分）， - b) 过滤掉所有"?"元素
- c) 应用
x到数据列，受益于Application.Index()的高级重组功能
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
该函数假设参数为单列（范围）。
由于2022-06-08的评论而进行编辑
整个示例都基于实际行号，从第一行开始（OP范围是A:A,B:B。如果您想允许范围从任何行开始，则需要通过减去可能的偏移量(行号+1-第一行)来更正行索引，改变a)部分中myFormula的定义：
Dim myFormula As String
myFormula = "if(" & a & "=""" & FilterID & """,row(" & a & ")+1 -" & rng1.Row & ",""?"")"
- T.M.
2
这个程序可以正常工作，但是它只返回第一个值。 - Christian
1感谢您的反馈，假设您的输入不是在我在此帖子中假定的第一行开始。请查看今天@Christian的编辑。 - T.M.
1
我最近有些空闲时间，对用户自定义函数产生了兴趣，于是决定制作我所想象的版本。我先说明一下，它并不好，并且过于冗长，但它能够工作！
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 i As Long, j As Long
'PARSING THE CRITERIA
Dim Regex As Object
Set Regex = CreateObject("VBScript.RegExp")
Regex.Pattern = "[=<>]+"
'Looking for comparison operators
Dim Matches As Object
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
'Trim IfRange to UsedRange
Set IfRange = Intersect(IfRange, IfRange.Parent.UsedRange)
'Default option for optional JoinRange input
If JoinRange Is Nothing Then
Set JoinRange = IfRange
Else
Set JoinRange = Intersect(JoinRange, JoinRange.Parent.UsedRange)
End If
'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 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。
- Toddleson
3
它不工作了。使用您的函数会出现“#NAME?”错误。 - Christian
2@Christian，#NAME?错误意味着函数名称未被识别或不可用。确保代码位于代码模块中（而非工作表模块）。这样，Excel可以找到该函数并能够识别名称。 - Toddleson
我刚刚发现问题是另一个。模块的名称不能与函数相同，否则会出现“#NAME?”错误。 - Christian
0
尝试使用这个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
- Rajput
3
我该如何使用这个函数？输入参数是什么？ - Toddleson
我的意思是：
Where 参数是什么。Criteria 的有效输入是什么，Optional If_Empty 是什么以及如果我包含或不包含它会发生什么？ - Toddleson0
=FILTER(B:B,A:A = "x")
备选方案：
假设您的数据位于Sheet1。 创建新工作表。将以下内容放入A1单元格：
=INDEX(Sheet1!A:A,B1,0))
使用这个公式自动填充列A。 然后将其放入单元格B1中：
=MATCH("x",Sheet1!B:B, 0)
然后将其放入B2单元格中：
=MATCH("x",INDIRECT("Sheet1!B" & B1+1 & ":B"), 0) + B1
然后从B2开始，用公式填充B列。
因此，在B列中，您将拥有来自Sheet1的筛选数据的索引。而A列实际上包含了筛选后的数据。
如果您需要筛选多个（非相邻）列，可以使用CHOOSE函数：
=INDEX(CHOOSE({1,2,3},Sheet1!A:A,Sheet1!H:H,Sheet1!D:D),B1,0)
- alexkovelsky
网页内容由stack overflow 提供, 点击上面的可以查看英文原文，
原文链接
原文链接