基于来自不同列但也来自不同行的值进行过滤

Question

如果“第 2 列”中的对应值为“B”，我想从“第 1 列”中过滤值，但前提是第 1 列中没有相同（重复）值在“第 2 列”中具有“A”值”。

为简化起见，输出应该是“2”和“4”，因为它们是在“列 1”的任何迭代中“列 2”中没有值“A”的唯一值。

我能够在 Excel 中使用两个动态公式和 XLOOKUP 做到这一点。

通过 VBA，我可以执行 For Each 循环，该循环将过滤第 2 列中值为“B”的所有值（在这种情况下，它将返回“列 1”中除“3”之外的所有值），这不是我需要什么。

Sub ChooseStatus()

Dim Sheet1 As Worksheet
Set Sheet1 = ThisWorkbook.Sheets("Sheet1")
    
'defining the area
lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

sr = Selection.Row

'defining categories
Item = Sheet1.Cells(sr, 1)
Status = Sheet1.Cells(sr, 2)

'loop
For i = 2 To lr
    If Sheet1.Cells(i, 2) = "B" Then
        Sheet1.Cells(i, 1).Interior.Color = rgbBlue
    End If
Next i
   
End Sub

Item	Status
1	A
1	B
1	B
2	B
2	B
3	A
3	A
4	B
5	A
5	B

Answer 1

如果您废弃了 Excel 版本 MS365 及其UNIQUE() 函数，您可以尝试以下过程Examplecall 以及用户定义的帮助函数GetFormula() 和IsValid()。（如果没有很多例子，那么如何在以前的版本中获取唯一值）.

这种方法还演示了以下常用 VBA 函数的使用

• Worksheet.Evaluate
• Filter
• Replace
• Join

示例调用

Option Explicit                 ' force declarations at code module head

Sub ExampleCall()

With Sheet1                     ' << change to wanted sheet Code(Name)
    Dim rng As Range
    Set rng = .Range("A2:B11")  ' << change to wanted range (note the starting "."-point)
'a) get uniques array & provide for temporary results array
    Dim uniques
    uniques = .Evaluate(GetFormula(rng))
    Dim results
    results = uniques           ' contains temporarily all uniques
End With
'b) mark all invalid items for deletion
    Dim i As Long
    For i = 1 To UBound(uniques)
        If Not IsValid(uniques, i) Then results(i) = "$DEL$"
    Next i
'c) remove marked items from results array
    results = Filter(results, "$DEL$", False)       ' negative filtering removes $DEL$ items
    MsgBox Join(results, vbNewLine), vbInformation, "Found elements"
End Sub

---

帮助功能

Function GetFormula(rng As Range, Optional Delim As String = "-") As String
'a) define column number within the passed range argument
    Const ITEM As Long = 1, STATUS As Long = 2          '
    If rng.Columns.Count < Application.Max(ITEM, STATUS) Then Exit Function  ' provide for sufficient columns
'b) define formula pattern
    Dim Pattern As String
    Pattern = "transpose(Unique(X & """ & Delim & """ & Y))"            ' get unique combined strings
'c) replace range references X and Y with address string
    GetFormula = Replace(Replace(Pattern, _
        "X", rng.Columns(ITEM).Address(0, 0)), _
        "Y", rng.Columns(STATUS).Address(0, 0))
End Function

Function IsValid(uniques, no As Long, _
            Optional Exclude As String = "A", _
            Optional Delim As String = "-") As Boolean
'a) get prefix of element no (i.e. string part before hyphen)
    Dim ItemPrefix As String
    ItemPrefix = Split(uniques(no), "-")(0)             ' isolate string part before "-" via Split()
'b) filter items to be excluded
    Dim tmp
    tmp = Filter(uniques, ItemPrefix & Delim & Exclude, True)   ' positive filtering of term to be excluded
'c) if there are no found items then return True as function result
    If UBound(tmp) = -1 Then                            ' upper boundary -1 indicates empty 0-based array
        IsValid = True                                  ' return positive function result
    End If
End Function